campbio / celda / 791

pending completion

Build # 791

Build Type

Pull #298

travis-ci

Committed by

web-flow

Commit Message

<a href="https://github.com/campbio/celda/commit/<a class=hub.com/campbio/celda/commit/<a class="double-link" href="https://git"><a class=hub.com/campbio/celda/commit/<a class="double-link" href="https://git"><a class=hub.com/campbio/celda/commit/<a class="double-link" href="https://git"><a class=hub.com/campbio/celda/commit/<a class="double-link" href="https://git"><a class=hub.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6">632015964">&lt;a href=&quot;https://github.com/campbio/celda/commit/</a><a class="double-link" href="https://github.com/campbio/celda/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/campbio/celda/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/campbio/celda/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6">632015964</a><a href="https://github.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6">&lt;a href=&quot;https://github.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6&quot;&gt;&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/campbio/celda/commit/&amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/campbio/celda/commit/&amp;amp;lt;a class=&amp;amp;quot;double-link&amp;amp;quot; href=&amp;amp;quot;https://git&amp;quot;&amp;gt;&amp;amp;lt;a class=&amp;lt;/a&amp;gt;hub.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6&amp;quot;&amp;gt;632015964&amp;lt;/a&amp;gt;&amp;lt;a href=&amp;quot;https://github.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc40532cacfb6&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/campbio/celda/commit/632015964f23d889240cfbc6b71fc405&amp;lt;/a&amp;gt;3</a>2cacfb6&quot;&gt;&amp;quot;&amp;gt;Merge &amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/campbio/celda/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/campbio/celda/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://github.com/campbio/celda/commit/a61139417&quot;&gt;a61139417&lt;/a&gt;&lt;a href=&quot;https://github.com/campbio/celda/co... (continued)

Pull Request Pull Request #298: Upgrade moduleHeatmap. Remove probability map blank page

Run Details

173 of 173 new or added lines in 6 files covered. (100.0%)

2465 of 11287 relevant lines covered (21.84%)

2719.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/R/celdaProbabilityMap.R

#' @title Probability map for a celda model
#' @description Renders probability and relative expression heatmaps to
#'  visualize the relationship between features and cell populations (or cell
#'  populations and samples).
#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object
#'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}
#'  slot to use. Default "counts".
#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot
#'  to use. Default "featureSubset".
#' @param level Character. One of "cellPopulation" or "Sample".
#'  "cellPopulation" will display the absolute probabilities and relative
#'  normalized expression of each module in each cell population.
#'  \strong{\code{level = "cellPopulation"} only works for celda_CG \code{sce}
#'  objects}. "sample" will display the absolute probabilities and relative
#'  normalized abundance of each cell population in each sample. Default
#'  "cellPopulation".
#' @param ... Additional parameters.
#' @seealso \link{celda_C} for clustering cells. \link{celda_CG} for
#'  clustering features and cells
#' @return A grob containing the specified plots
#' @export
setGeneric("celdaProbabilityMap",
    function(sce, ...) {
        standardGeneric("celdaProbabilityMap")
    })


#' @rdname celdaProbabilityMap
#' @importFrom gridExtra grid.arrange
#' @importFrom RColorBrewer brewer.pal
#' @importFrom grDevices colorRampPalette
#' @examples
#' data(sceCeldaCG)
#' celdaProbabilityMap(sceCeldaCG)
#' @export
setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
    function(sce, useAssay = "counts", altExpName = "featureSubset",
        level = c("cellPopulation", "sample")) {

        altExp <- SingleCellExperiment::altExp(sce, altExpName)
        level <- match.arg(level)
        if (celdaModel(sce, altExpName = altExpName) == "celda_C") {
            if (level == "cellPopulation") {
                warning("'level' has been set to 'sample'")
            }
            pm <- .celdaProbabilityMapC(sce = altExp, useAssay = useAssay,
                level = "sample")
        } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {
            pm <- .celdaProbabilityMapCG(sce = altExp, useAssay = useAssay,
                level = level)
        } else {
            stop("S4Vectors::metadata(altExp(sce,",
                " altExpName))$celda_parameters$model must be",
                " one of 'celda_C', or 'celda_CG'!")
        }
        return(pm)
    }
)


.celdaProbabilityMapC <- function(sce, useAssay, level) {
    counts <- SummarizedExperiment::assay(sce, i = useAssay)
    counts <- .processCounts(counts)

    zInclude <- which(tabulate(SummarizedExperiment::colData(
        sce)$celda_cell_cluster,
        S4Vectors::metadata(sce)$celda_parameters$K) > 0)

    factorized <- .factorizeMatrixCelda_C(sce, useAssay = useAssay,
        type = "proportion")

    samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
    col <- grDevices::colorRampPalette(c("white",
        "blue",
        "#08306B",
        "#006D2C",
        "yellowgreen",
        "yellow",
        "orange",
        "red"))(100)
    breaks <- seq(0, 1, length.out = length(col))
    g1 <- plotHeatmap(samp,
        colorScheme = "sequential",
        scaleRow = NULL,
        clusterCell = FALSE,
        clusterFeature = FALSE,
        showNamesCell = TRUE,
        showNamesFeature = TRUE,
        breaks = breaks,
        col = col,
        main = "Absolute Probability")

    if (ncol(samp) > 1) {
        sampNorm <- normalizeCounts(samp,
            normalize = "proportion",
            transformationFun = sqrt,
            scaleFun = base::scale)
        g2 <- plotHeatmap(sampNorm,
            colorScheme = "divergent",
            clusterCell = FALSE,
            clusterFeature = FALSE,
            showNamesCell = TRUE,
            showNamesFeature = TRUE,
            main = "Relative Abundance")
        return(gridExtra::grid.arrange(g1, g2, ncol = 2))
    } else {
        return(gridExtra::grid.arrange(g1))
    }
}


.celdaProbabilityMapCG <- function(sce, useAssay, level) {
    counts <- SummarizedExperiment::assay(sce, i = useAssay)
    counts <- .processCounts(counts)

    factorized <- .factorizeMatrixCelda_CG(sce, useAssay,
        type = c("counts", "proportion"))
    zInclude <- which(tabulate(SummarizedExperiment::colData(
        sce)$celda_cell_cluster,
        S4Vectors::metadata(sce)$celda_parameters$K) > 0)
    yInclude <- which(tabulate(SummarizedExperiment::rowData(
        sce)$celda_feature_module,
        S4Vectors::metadata(sce)$celda_parameters$L) > 0)

    if (level == "cellPopulation") {
        pop <- factorized$proportions$cellPopulation[yInclude,
            zInclude,
            drop = FALSE]
        popNorm <- normalizeCounts(pop,
            normalize = "proportion",
            transformationFun = sqrt,
            scaleFun = base::scale)

        percentile9 <- round(stats::quantile(pop, .9), digits = 2) * 100
        col1 <- grDevices::colorRampPalette(c(
            "#FFFFFF",
            RColorBrewer::brewer.pal(n = 9, name = "Blues")
        ))(percentile9)
        col2 <- grDevices::colorRampPalette(c(
            "#08306B",
            c(
                "#006D2C", "Yellowgreen", "Yellow", "Orange",
                "Red"
            )
        ))(100 - percentile9)
        col <- c(col1, col2)
        breaks <- seq(0, 1, length.out = length(col))

        g1 <- plotHeatmap(pop,
            colorScheme = "sequential",
            scaleRow = NULL,
            clusterCell = FALSE,
            clusterFeature = FALSE,
            showNamesCell = TRUE,
            showNamesFeature = TRUE,
            breaks = breaks,
            col = col,
            main = "Absolute Probability")
        g2 <- plotHeatmap(popNorm,
            colorScheme = "divergent",
            clusterCell = FALSE,
            clusterFeature = FALSE,
            showNamesCell = TRUE,
            showNamesFeature = TRUE,
            main = "Relative Expression")
        gridExtra::grid.arrange(g1, g2, ncol = 2)
    } else {
        samp <- factorized$proportions$sample
        col <- grDevices::colorRampPalette(c(
            "white",
            "blue",
            "#08306B",
            "#006D2C",
            "yellowgreen",
            "yellow",
            "orange",
            "red"
        ))(100)
        breaks <- seq(0, 1, length.out = length(col))
        g1 <- plotHeatmap(samp,
            colorScheme = "sequential",
            scaleRow = NULL,
            clusterCell = FALSE,
            clusterFeature = FALSE,
            showNamesCell = TRUE,
            showNamesFeature = TRUE,
            breaks = breaks,
            col = col,
            main = "Absolute Probability")

        if (ncol(samp) > 1) {
            sampNorm <- normalizeCounts(factorized$counts$sample,
                normalize = "proportion",
                transformationFun = sqrt,
                scaleFun = base::scale
            )
            g2 <- plotHeatmap(sampNorm,
                colorScheme = "divergent",
                clusterCell = FALSE,
                clusterFeature = FALSE,
                showNamesCell = TRUE,
                showNamesFeature = TRUE,
                main = "Relative Abundance")
            gridExtra::grid.arrange(g1, g2, ncol = 2)
        } else {
            gridExtra::grid.arrange(g1)
        }
    }
}

1	#' @title Probability map for a celda model
2	#' @description Renders probability and relative expression heatmaps to
3	#' visualize the relationship between features and cell populations (or cell
4	#' populations and samples).
5	#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object
6	#' returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
7	#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}
8	#' slot to use. Default "counts".
9	#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot
10	#' to use. Default "featureSubset".
11	#' @param level Character. One of "cellPopulation" or "Sample".
12	#' "cellPopulation" will display the absolute probabilities and relative
13	#' normalized expression of each module in each cell population.
14	#' \strong{\code{level = "cellPopulation"} only works for celda_CG \code{sce}
15	#' objects}. "sample" will display the absolute probabilities and relative
16	#' normalized abundance of each cell population in each sample. Default
17	#' "cellPopulation".
18	#' @param ... Additional parameters.
19	#' @seealso \link{celda_C} for clustering cells. \link{celda_CG} for
20	#' clustering features and cells
21	#' @return A grob containing the specified plots
22	#' @export
23	setGeneric("celdaProbabilityMap",
24	function(sce, ...) {
25	standardGeneric("celdaProbabilityMap")	×
26	})
27
28
29	#' @rdname celdaProbabilityMap
30	#' @importFrom gridExtra grid.arrange
31	#' @importFrom RColorBrewer brewer.pal
32	#' @importFrom grDevices colorRampPalette
33	#' @examples
34	#' data(sceCeldaCG)
35	#' celdaProbabilityMap(sceCeldaCG)
36	#' @export
37	setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
38	function(sce, useAssay = "counts", altExpName = "featureSubset",
39	level = c("cellPopulation", "sample")) {
40
41	altExp <- SingleCellExperiment::altExp(sce, altExpName)	×
42	level <- match.arg(level)	×
43	if (celdaModel(sce, altExpName = altExpName) == "celda_C") {	×
44	if (level == "cellPopulation") {	×
45	warning("'level' has been set to 'sample'")	×
46	}
47	pm <- .celdaProbabilityMapC(sce = altExp, useAssay = useAssay,	×
48	level = "sample")	×
49	} else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {	×
50	pm <- .celdaProbabilityMapCG(sce = altExp, useAssay = useAssay,	×
51	level = level)	×
52	} else {
53	stop("S4Vectors::metadata(altExp(sce,",	×
54	" altExpName))$celda_parameters$model must be",	×
55	" one of 'celda_C', or 'celda_CG'!")	×
56	}
57	return(pm)	×
58	}
59	)
60
61
62	.celdaProbabilityMapC <- function(sce, useAssay, level) {
63	counts <- SummarizedExperiment::assay(sce, i = useAssay)	×
64	counts <- .processCounts(counts)	×
65
66	zInclude <- which(tabulate(SummarizedExperiment::colData(	×
67	sce)$celda_cell_cluster,	×
68	S4Vectors::metadata(sce)$celda_parameters$K) > 0)	×
69
70	factorized <- .factorizeMatrixCelda_C(sce, useAssay = useAssay,	×
71	type = "proportion")	×
72
73	samp <- factorized$proportions$sample[zInclude, , drop = FALSE]	×
74	col <- grDevices::colorRampPalette(c("white",	×
75	"blue",	×
76	"#08306B",	×
77	"#006D2C",	×
78	"yellowgreen",	×
79	"yellow",	×
80	"orange",	×
81	"red"))(100)	×
82	breaks <- seq(0, 1, length.out = length(col))	×
83	g1 <- plotHeatmap(samp,	×
84	colorScheme = "sequential",	×
85	scaleRow = NULL,	×
86	clusterCell = FALSE,	×
87	clusterFeature = FALSE,	×
88	showNamesCell = TRUE,	×
89	showNamesFeature = TRUE,	×
90	breaks = breaks,	×
91	col = col,	×
92	main = "Absolute Probability")	×
93
94	if (ncol(samp) > 1) {	×
95	sampNorm <- normalizeCounts(samp,	×
96	normalize = "proportion",	×
97	transformationFun = sqrt,	×
98	scaleFun = base::scale)	×
99	g2 <- plotHeatmap(sampNorm,	×
100	colorScheme = "divergent",	×
101	clusterCell = FALSE,	×
102	clusterFeature = FALSE,	×
103	showNamesCell = TRUE,	×
104	showNamesFeature = TRUE,	×
105	main = "Relative Abundance")	×
106	return(gridExtra::grid.arrange(g1, g2, ncol = 2))	×
107	} else {
108	return(gridExtra::grid.arrange(g1))	×
109	}
110	}
111
112
113	.celdaProbabilityMapCG <- function(sce, useAssay, level) {
114	counts <- SummarizedExperiment::assay(sce, i = useAssay)	×
115	counts <- .processCounts(counts)	×
116
117	factorized <- .factorizeMatrixCelda_CG(sce, useAssay,	×
118	type = c("counts", "proportion"))	×
119	zInclude <- which(tabulate(SummarizedExperiment::colData(	×
120	sce)$celda_cell_cluster,	×
121	S4Vectors::metadata(sce)$celda_parameters$K) > 0)	×
122	yInclude <- which(tabulate(SummarizedExperiment::rowData(	×
123	sce)$celda_feature_module,	×
124	S4Vectors::metadata(sce)$celda_parameters$L) > 0)	×
125
126	if (level == "cellPopulation") {	×
127	pop <- factorized$proportions$cellPopulation[yInclude,	×
128	zInclude,	×
129	drop = FALSE]	×
130	popNorm <- normalizeCounts(pop,	×
131	normalize = "proportion",	×
132	transformationFun = sqrt,	×
133	scaleFun = base::scale)	×
134
135	percentile9 <- round(stats::quantile(pop, .9), digits = 2) * 100	×
136	col1 <- grDevices::colorRampPalette(c(	×
137	"#FFFFFF",	×
138	RColorBrewer::brewer.pal(n = 9, name = "Blues")	×
139	))(percentile9)	×
140	col2 <- grDevices::colorRampPalette(c(	×
141	"#08306B",	×
142	c(	×
143	"#006D2C", "Yellowgreen", "Yellow", "Orange",	×
144	"Red"	×
145	)
146	))(100 - percentile9)	×
147	col <- c(col1, col2)	×
148	breaks <- seq(0, 1, length.out = length(col))	×
149
150	g1 <- plotHeatmap(pop,	×
151	colorScheme = "sequential",	×
152	scaleRow = NULL,	×
153	clusterCell = FALSE,	×
154	clusterFeature = FALSE,	×
155	showNamesCell = TRUE,	×
156	showNamesFeature = TRUE,	×
157	breaks = breaks,	×
158	col = col,	×
159	main = "Absolute Probability")	×
160	g2 <- plotHeatmap(popNorm,	×
161	colorScheme = "divergent",	×
162	clusterCell = FALSE,	×
163	clusterFeature = FALSE,	×
164	showNamesCell = TRUE,	×
165	showNamesFeature = TRUE,	×
166	main = "Relative Expression")	×
167	gridExtra::grid.arrange(g1, g2, ncol = 2)	×
168	} else {
169	samp <- factorized$proportions$sample	×
170	col <- grDevices::colorRampPalette(c(	×
171	"white",	×
172	"blue",	×
173	"#08306B",	×
174	"#006D2C",	×
175	"yellowgreen",	×
176	"yellow",	×
177	"orange",	×
178	"red"	×
179	))(100)	×
180	breaks <- seq(0, 1, length.out = length(col))	×
181	g1 <- plotHeatmap(samp,	×
182	colorScheme = "sequential",	×
183	scaleRow = NULL,	×
184	clusterCell = FALSE,	×
185	clusterFeature = FALSE,	×
186	showNamesCell = TRUE,	×
187	showNamesFeature = TRUE,	×
188	breaks = breaks,	×
189	col = col,	×
190	main = "Absolute Probability")	×
191
192	if (ncol(samp) > 1) {	×
193	sampNorm <- normalizeCounts(factorized$counts$sample,	×
194	normalize = "proportion",	×
195	transformationFun = sqrt,	×
196	scaleFun = base::scale	×
197	)
198	g2 <- plotHeatmap(sampNorm,	×
199	colorScheme = "divergent",	×
200	clusterCell = FALSE,	×
201	clusterFeature = FALSE,	×
202	showNamesCell = TRUE,	×
203	showNamesFeature = TRUE,	×
204	main = "Relative Abundance")	×
205	gridExtra::grid.arrange(g1, g2, ncol = 2)	×
206	} else {
207	gridExtra::grid.arrange(g1)	×
208	}
209	}
210	}

campbio / celda / 791

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous