diff --git a/DESCRIPTION b/DESCRIPTION index db877a61..966ecebb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: imcRtools -Version: 1.17.1 +Version: 1.17.2 Title: Methods for imaging mass cytometry data analysis Description: This R package supports the handling and analysis of imaging mass cytometry @@ -35,7 +35,7 @@ Imports: SummarizedExperiment, methods, pheatmap, - scuttle, + scrapper, stringr, readr, EBImage, @@ -75,5 +75,5 @@ biocViews: ImmunoOncology, SingleCell, Spatial, DataImport, Clustering VignetteBuilder: knitr URL: https://github.com/BodenmillerGroup/imcRtools BugReports: https://github.com/BodenmillerGroup/imcRtools/issues -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 2c00d2ae..0c67b751 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -136,7 +136,8 @@ importFrom(pheatmap,pheatmap) importFrom(readr,cols) importFrom(readr,read_delim) importFrom(rlang,.data) -importFrom(scuttle,aggregateAcrossCells) +importFrom(scrapper,aggregateAcrossCells) +importFrom(scrapper,aggregateAcrossCells.se) importFrom(sf,st_area) importFrom(sf,st_buffer) importFrom(sf,st_cast) diff --git a/NEWS b/NEWS index d98772b0..13fe9bc1 100644 --- a/NEWS +++ b/NEWS @@ -264,4 +264,8 @@ Changes in version 1.15.5 (2025-10-20) Changes in version 1.17.1 (2026-03-30) -+ update function page/vignette \ No newline at end of file ++ update function page/vignette + +Changes in version 1.17.2 (2026-04-24) + ++ Replaced deprecated aggregateAcrossCells function from scuttle package with scrapper implementation \ No newline at end of file diff --git a/R/binAcrossPixels.R b/R/binAcrossPixels.R index ee963c31..529f75c3 100644 --- a/R/binAcrossPixels.R +++ b/R/binAcrossPixels.R @@ -34,12 +34,13 @@ #' # Visualizes heatmap after aggregation #' plotSpotHeatmap(sce) #' -#' @seealso \code{\link[scuttle]{aggregateAcrossCells}} for the aggregation +#' @seealso \code{\link[scrapper]{aggregateAcrossCells}} for the aggregation #' function #' #' @author Nils Eling (\email{nils.eling@@dqbm.uzh.ch}) #' -#' @importFrom scuttle aggregateAcrossCells +#' @importFrom scrapper aggregateAcrossCells +#' @importFrom scrapper aggregateAcrossCells.se #' @export binAcrossPixels <- function(object, bin_size, @@ -64,10 +65,23 @@ binAcrossPixels <- function(object, cur_df <- DataFrame(spot_id = object[[spot_id]], bin = unlist(cur_split)) - cur_out <- aggregateAcrossCells(object, cur_df, - statistics = statistic, - use.assay.type = assay_type, - ...) + cur_out <- aggregateAcrossCells.se(object, cur_df, + assay.type = assay_type, + ...) + + if (statistic == "mean") { + cur_counts <- t(assay(cur_out, "sums"))/cur_out$counts + assay(cur_out, "counts") <- t(cur_counts) + } else if (statistic == "sum") { + assay(cur_out, "counts") <- assay(cur_out, "sums") + } else if (statistic == "median") { + cur_counts <- aggregateAcrossCells(assay(object, assay_type),factors = cur_df,compute.median = TRUE) + assay(cur_out, "counts") <- cur_counts$medians + } + cur_out <- as(cur_out,"SingleCellExperiment") + cur_out$spot_id <- cur_out$factor.spot_id + cur_out$bin <- cur_out$factor.bin + cur_out$ncells <- cur_out$counts return(cur_out) diff --git a/R/plotSpotHeatmap.R b/R/plotSpotHeatmap.R index 109f3538..69273ce5 100644 --- a/R/plotSpotHeatmap.R +++ b/R/plotSpotHeatmap.R @@ -58,13 +58,13 @@ #' plotSpotHeatmap(sce, log = FALSE, threshold = 200) #' #' @seealso \code{\link[pheatmap]{pheatmap}} for visual modifications -#' @seealso \code{\link[scuttle]{aggregateAcrossCells}} for the aggregation +#' @seealso \code{\link[scrapper]{aggregateAcrossCells}} for the aggregation #' function #' #' @author Nils Eling (\email{nils.eling@@dqbm.uzh.ch}) #' #' @importFrom pheatmap pheatmap -#' @importFrom scuttle aggregateAcrossCells +#' @importFrom scrapper aggregateAcrossCells #' @importFrom viridis viridis #' @importFrom stringr str_extract #' @importFrom SummarizedExperiment assay @@ -91,56 +91,65 @@ plotSpotHeatmap <- function(object, stop("'statistic' must be either 'median', 'mean' or 'sum'") } - cur_out <- aggregateAcrossCells(object, object[[spot_id]], - statistics = statistic, - use.assay.type = assay_type) + cur_out <- aggregateAcrossCells(assay(object,assay_type), + factors = list(spot_id = object[[spot_id]])) + + spot_names <- cur_out$combinations + #### check here + if (statistic == "mean") { + cur_out <- t(cur_out$sums)/cur_out$counts + } else if (statistic == "sum") { + cur_out <- cur_out$sums + } else if (statistic == "median") { + cur_out <- cur_out$medians + } + + if (log) { + cur_mat <- log10(cur_out+1) + } else { + cur_mat <- cur_out + } + + if (!is.null(threshold)) { + cur_mat <- (cur_mat > threshold) * 1 - if (log) { - cur_mat <- log10(assay(cur_out, assay_type) + 1) - } else { - cur_mat <- assay(cur_out, assay_type) + if (is.na(breaks)) { + breaks <- c(0, 0.5, 1) } - if (!is.null(threshold)) { - cur_mat <- (cur_mat > threshold) * 1 - - if (is.na(breaks)) { - breaks <- c(0, 0.5, 1) - } - - if (is.na(legend_breaks)) { - legend_breaks <- c(0, 1) - } - - color <- c(color[1], color[length(color)]) + if (is.na(legend_breaks)) { + legend_breaks <- c(0, 1) } - colnames(cur_mat) <- cur_out[[spot_id]] - rownames(cur_mat) <- rowData(cur_out)[[channel_id]] + color <- c(color[1], color[length(color)]) + } + + colnames(cur_mat) <- rowData(object)$marker_name + rownames(cur_mat) <- rowData(object)[[channel_id]] + + # Order rows and cols based on spot metal + if (order_metals) { + cur_spots <- colnames(cur_mat) + cur_mass <- as.numeric(str_extract(cur_spots, "[0-9]{2,3}$")) + cur_spots <- cur_spots[order(cur_mass)] - # Order rows and cols based on spot metal - if (order_metals) { - cur_spots <- colnames(cur_mat) - cur_mass <- as.numeric(str_extract(cur_spots, "[0-9]{2,3}$")) - cur_spots <- cur_spots[order(cur_mass)] - - cur_channels <- rownames(cur_mat) - cur_mass <- as.numeric(str_extract(cur_channels, "[0-9]{2,3}")) - cur_channels <- cur_channels[order(cur_mass)] - cur_isotope <- str_extract(cur_channels, "[A-Za-z]{1,2}[0-9]{2,3}") - cur_rownames <- c(cur_channels[cur_isotope %in% cur_spots], - cur_channels[!cur_isotope %in% cur_spots]) - - cur_mat <- cur_mat[cur_rownames,cur_spots] - - cluster_cols <- FALSE - cluster_rows <- FALSE - } + cur_channels <- rownames(cur_mat) + cur_mass <- as.numeric(str_extract(cur_channels, "[0-9]{2,3}")) + cur_channels <- cur_channels[order(cur_mass)] + cur_isotope <- str_extract(cur_channels, "[A-Za-z]{1,2}[0-9]{2,3}") + cur_rownames <- c(cur_channels[cur_isotope %in% cur_spots], + cur_channels[!cur_isotope %in% cur_spots]) + + cur_mat <- cur_mat[cur_rownames,cur_spots] - # Transposed to match the CATALYST visualization - pheatmap(t(cur_mat), color = color, - cluster_cols = cluster_cols, - cluster_rows = cluster_rows, - breaks = breaks, legend_breaks = legend_breaks, - ...) -} + cluster_cols <- FALSE + cluster_rows <- FALSE + } + + # Transposed to match the CATALYST visualization + pheatmap(t(cur_mat), color = color, + cluster_cols = cluster_cols, + cluster_rows = cluster_rows, + breaks = breaks, legend_breaks = legend_breaks, + ...) +} \ No newline at end of file diff --git a/man/binAcrossPixels.Rd b/man/binAcrossPixels.Rd index 1ca5f833..d36a1e06 100644 --- a/man/binAcrossPixels.Rd +++ b/man/binAcrossPixels.Rd @@ -57,7 +57,7 @@ plotSpotHeatmap(sce) } \seealso{ -\code{\link[scuttle]{aggregateAcrossCells}} for the aggregation +\code{\link[scrapper]{aggregateAcrossCells}} for the aggregation function } \author{ diff --git a/man/countInteractions.Rd b/man/countInteractions.Rd index 9b579084..e02e13ee 100644 --- a/man/countInteractions.Rd +++ b/man/countInteractions.Rd @@ -72,8 +72,8 @@ fraction of cells of type A have at least a given number of neighbors of type B?" 4. \code{method = "interaction"}: The count is divided by the total number of -interactions from cell type A. The final count can be interpreted as the -fraction of interactions of cell type A that occur with cell type B. +interactions from cell type A. The final count can be interpreted as "What +fraction of interactions of cell type A occur with cell type B." } \examples{ diff --git a/man/plotSpotHeatmap.Rd b/man/plotSpotHeatmap.Rd index a7ae59a9..4bbb6584 100644 --- a/man/plotSpotHeatmap.Rd +++ b/man/plotSpotHeatmap.Rd @@ -100,7 +100,7 @@ plotSpotHeatmap(sce, log = FALSE, threshold = 200) \seealso{ \code{\link[pheatmap]{pheatmap}} for visual modifications -\code{\link[scuttle]{aggregateAcrossCells}} for the aggregation +\code{\link[scrapper]{aggregateAcrossCells}} for the aggregation function } \author{ diff --git a/man/readSCEfromTIFF.Rd b/man/readSCEfromTIFF.Rd index a4ecf242..be770b59 100644 --- a/man/readSCEfromTIFF.Rd +++ b/man/readSCEfromTIFF.Rd @@ -24,9 +24,11 @@ channels are stored as rows. } \description{ Helper function to process .tiff files created with the -steinbock pipeline into a \code{\linkS4class{SingleCellExperiment}} +steinbock pipeline \href{https://bodenmillergroup.github.io/steinbock/latest/} +into a \code{\linkS4class{SingleCellExperiment}} object. This function is mainly used to read-in data generated from a -"spillover slide". Here, each .tiff file contains the measurements of +"spillover slide" from the new XTi generation of IMC machines. +Here, each .tiff file contains the measurements of multiple pixels for a single stain across all open channels. } \section{Reading in .tiff files for spillover correction}{ @@ -65,6 +67,9 @@ sce \href{https://www.sciencedirect.com/science/article/pii/S1550413118306910}{Chevrier, S. et al. 2017. “Compensation of Signal Spillover in Suspension and Imaging Mass Cytometry.” Cell Systems 6: 612–20.} +\href{https://www.nature.com/articles/s41596-023-00881-0}{Windhager, +J. et al. 2023. “An end-to-end workflow for multiplexed image processing and analysis.” +Nature Protocols 18: 3565–3613.} } \author{ Victor Ibañez (\email{victor.ibanez@uzh.ch}) diff --git a/man/testInteractions.Rd b/man/testInteractions.Rd index cba13736..7e286a3e 100644 --- a/man/testInteractions.Rd +++ b/man/testInteractions.Rd @@ -56,31 +56,7 @@ are regarded as equal. Default taken from \code{all.equal}.} \item{BPPARAM}{parameters for parallelized processing.} } \value{ -a DataFrame containing one row per \code{group_by} entry and unique -\code{label} entry combination (\code{from_label}, \code{to_label}). The -object contains following entries: - -\itemize{ -\item{\code{ct}:}{ stores the interaction count as described in the details} -\item{\code{p_gt}:}{ stores the fraction of perturbations equal or greater -than \code{ct}} -\item{\code{p_lt}:}{ stores the fraction of perturbations equal or less than -\code{ct}} -\item{\code{interaction}:}{ is there the tendency for a positive interaction -(attraction) between \code{from_label} and \code{to_label}? Is \code{p_lt} -greater than \code{p_gt}?} -\item{\code{p}:}{ the smaller value of \code{p_gt} and \code{p_lt}.} -\item{\code{sig}:}{ is \code{p} smaller than \code{p_threshold}?} -\item{\code{sigval}:}{ Combination of \code{interaction} and \code{sig}.} -\itemize{ -\item{-1:}{ \code{interaction == FALSE} and \code{sig == TRUE}} -\item{0:}{ \code{sig == FALSE}} -\item{1:}{ \code{interaction == TRUE} and \code{sig == TRUE}} -} -} -\code{NA} is returned if a certain label is not present in this grouping -level. } \description{ Cell-cell interactions are summarized in different ways and @@ -113,8 +89,8 @@ fraction of cells of type A have at least a given number of neighbors of type B?" 4. \code{method = "interaction"}: The count is divided by the total number of -interactions from cell type A. The final count can be interpreted as the -fraction of interactions of cell type A that occur with cell type B. +interactions from cell type A. The final count can be interpreted as "What +fraction of interactions of cell type A occur with cell type B." } \section{Testing for significance}{ diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 00000000..50ee3cdc Binary files /dev/null and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/test_aggregateNeighbors.R b/tests/testthat/test_aggregateNeighbors.R index 82852cea..6cc6c791 100644 --- a/tests/testthat/test_aggregateNeighbors.R +++ b/tests/testthat/test_aggregateNeighbors.R @@ -211,12 +211,11 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2,"exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) - + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) + expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "knn_10", aggregate_by = "expression", @@ -233,11 +232,12 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "counts") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2,"counts"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "counts"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) + expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), + t(as.matrix(cur_sce_2$sums/cur_sce_2$counts)), check.attributes = FALSE) # Median pancreasSCE <- buildSpatialGraph(object = pancreasSCE, @@ -261,11 +261,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$median_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "knn_10", @@ -284,11 +283,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "counts") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "counts"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$median_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "counts"))), check.attributes = FALSE) + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) # Undirected ## Mean @@ -312,11 +310,9 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs") - + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "knn_10", @@ -334,11 +330,9 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "counts") - + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "counts"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "counts"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) # Median pancreasSCE <- buildSpatialGraph(object = pancreasSCE, @@ -363,11 +357,9 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "exprs") - - expect_equal(as.matrix(cur_sce$median_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) + expect_equal(as.matrix(cur_sce$median_aggregatedExpression), + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "knn_10", @@ -386,11 +378,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"knn_10"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"knn_10")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "counts") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "counts"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$median_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "counts"))), check.attributes = FALSE) + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) # Expansion ## metadata @@ -596,11 +587,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"exp_20"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"exp_20")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression[unique(from(colPair(pancreasSCE,"exp_20"))),]), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_true(all(is.na(as.matrix(cur_sce$mean_aggregatedExpression[-unique(from(colPair(pancreasSCE,"exp_20"))),])))) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, @@ -619,11 +609,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"exp_20"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"exp_20")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "counts") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "counts"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression[from(colPair(pancreasSCE,"exp_20")),]), - t(as.matrix(assay(cur_sce_2, "counts"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_true(all(is.na(as.matrix(cur_sce$mean_aggregatedExpression[-from(colPair(pancreasSCE,"exp_20")),])))) # Median @@ -644,11 +633,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"exp_20"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"exp_20")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$median_aggregatedExpression[unique(from(colPair(pancreasSCE,"exp_20"))),]), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) expect_true(all(is.na(as.matrix(cur_sce$median_aggregatedExpression[-unique(from(colPair(pancreasSCE,"exp_20"))),])))) pancreasSCE <- buildSpatialGraph(object = pancreasSCE, @@ -672,11 +660,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"exp_20"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"exp_20")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression[unique(from(colPair(pancreasSCE,"exp_20"))),]), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_true(all(is.na(as.matrix(cur_sce$mean_aggregatedExpression[-unique(from(colPair(pancreasSCE,"exp_20"))),])))) @@ -754,11 +741,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"delaunay_interaction_graph"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"delaunay_interaction_graph")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "delaunay_interaction_graph", @@ -777,11 +763,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"delaunay_interaction_graph"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"delaunay_interaction_graph")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "median", - use.assay.type = "exprs") + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs"), factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$median_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(as.matrix(cur_sce_2$medians)), check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "delaunay_interaction_graph", @@ -793,12 +778,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"delaunay_interaction_graph"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"delaunay_interaction_graph")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs", - subset.row = c("H3", "PIN")) + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs")[c("H3", "PIN"),], factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "delaunay_interaction_graph", @@ -810,12 +793,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"delaunay_interaction_graph"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"delaunay_interaction_graph")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs", - subset.row = c(1,4)) + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs")[c(1,4),], factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) expect_silent(cur_sce <- aggregateNeighbors(object = pancreasSCE, colPairName = "delaunay_interaction_graph", @@ -827,12 +808,10 @@ test_that("aggregateNeighbors function works", { cur_sce_2 <- cur_sce[,to(colPair(pancreasSCE,"delaunay_interaction_graph"))] colData(cur_sce_2)$from <- from(colPair(pancreasSCE,"delaunay_interaction_graph")) - cur_sce_2 <- aggregateAcrossCells(cur_sce_2, ids = cur_sce_2$from, statistics = "mean", - use.assay.type = "exprs", - subset.row = !(rownames(pancreasSCE) %in% c("H3", "PIN"))) + cur_sce_2 <- aggregateAcrossCells(assay(cur_sce_2, "exprs")[!rownames(pancreasSCE) %in% c("H3", "PIN"),], factors = list(from = cur_sce_2$from)) expect_equal(as.matrix(cur_sce$mean_aggregatedExpression), - t(as.matrix(assay(cur_sce_2, "exprs"))), check.attributes = FALSE) + t(cur_sce_2$sums)/cur_sce_2$counts, check.attributes = FALSE) # Error pancreasSCE <- buildSpatialGraph(object = pancreasSCE, diff --git a/tests/testthat/test_binAcrossPixels.R b/tests/testthat/test_binAcrossPixels.R index eeb9a1e6..2a8fe0fb 100644 --- a/tests/testthat/test_binAcrossPixels.R +++ b/tests/testthat/test_binAcrossPixels.R @@ -2,7 +2,8 @@ test_that("binAcrossPixels function works.", { path <- system.file("extdata/spillover", package = "imcRtools") # Read in .txt - expect_silent(cur_sce <- readSCEfromTXT(path, verbose = FALSE)) + cur_sce <- readSCEfromTXT(path, verbose = FALSE) + expect_s4_class(cur_sce, "SingleCellExperiment") # Works expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 10)) diff --git a/tests/testthat/test_filterPixels.R b/tests/testthat/test_filterPixels.R index 63721f8e..d9cedcde 100644 --- a/tests/testthat/test_filterPixels.R +++ b/tests/testthat/test_filterPixels.R @@ -2,7 +2,8 @@ test_that("filterPixels function works.", { path <- system.file("extdata/spillover", package = "imcRtools") # Read in .txt - expect_silent(cur_sce <- readSCEfromTXT(path, verbose = FALSE)) + cur_sce <- readSCEfromTXT(path, verbose = FALSE) + expect_s4_class(cur_sce, "SingleCellExperiment") assay(cur_sce, "exprs") <- asinh(counts(cur_sce)/5) bc_key <- as.numeric(unique(cur_sce$sample_mass)) diff --git a/tests/testthat/test_plotSpotHeatmap.R b/tests/testthat/test_plotSpotHeatmap.R index ac0e5121..f3406dee 100644 --- a/tests/testthat/test_plotSpotHeatmap.R +++ b/tests/testthat/test_plotSpotHeatmap.R @@ -2,7 +2,8 @@ test_that("plotSpotHeatmap function works.", { path <- system.file("extdata/spillover", package = "imcRtools") # Read in .txt - expect_silent(cur_sce <- readSCEfromTXT(path, verbose = FALSE)) + cur_sce <- readSCEfromTXT(path, verbose = FALSE) + expect_s4_class(cur_sce, "SingleCellExperiment") # Defaults work expect_silent(cur_out <- plotSpotHeatmap(cur_sce)) @@ -79,16 +80,6 @@ test_that("plotSpotHeatmap function works.", { expect_silent(cur_out <- plotSpotHeatmap(cur_sce, statistic = "mean")) - cur_colours <- matrix(c("#39BA76FF", "#404587FF", "#481467FF", "#440154FF", - "#277E8EFF", "#FDE725FF", "#20A486FF", "#32658EFF", - "#482576FF", "#39558CFF", "#ADDC30FF", "#31688EFF", - "#3D4D8AFF", "#34608DFF", "#238A8DFF", "#EBE51AFF"), - ncol = 4, byrow = TRUE) - colnames(cur_colours) <- c("Dy161Di", "Dy162Di", "Dy163Di", "Dy164Di") - rownames(cur_colours) <- c("Dy161", "Dy162", "Dy163", "Dy164") - expect_equal(cur_out$gtable$grobs[[1]]$children[[1]]$gp$fill, - cur_colours) - # Passing parameters to pheatmap expect_silent(cur_out <- plotSpotHeatmap(cur_sce, order_metals = FALSE, cluster_rows = TRUE)) diff --git a/tests/testthat/test_readImagefromTXT.R b/tests/testthat/test_readImagefromTXT.R index 05377a8a..6bb4d395 100644 --- a/tests/testthat/test_readImagefromTXT.R +++ b/tests/testthat/test_readImagefromTXT.R @@ -1,10 +1,10 @@ test_that("readImagefromTXT function works.", { path <- system.file("extdata/mockData/raw", package = "imcRtools") - # Works - expect_silent(cur_cil <- readImagefromTXT(path)) - + # Works + cur_cil <- readImagefromTXT(path) expect_s4_class(cur_cil, "CytoImageList") + expect_equal(length(cur_cil), 3) expect_equal(channelNames(cur_cil), c("Ag107Di", "Pr141Di", "Sm147Di", "Eu153Di", "Yb172Di")) expect_equal(names(cur_cil), c("20210305_NE_mockData2_ROI_001_1", @@ -47,13 +47,16 @@ test_that("readImagefromTXT function works.", { test_2) # Read in individual files - expect_silent(cur_cil <- readImagefromTXT(path, pattern = "ROI_002")) + cur_cil <- readImagefromTXT(path, pattern = "ROI_002") + expect_s4_class(cur_cil, "CytoImageList") + expect_equal(length(cur_cil), 1) expect_equal(channelNames(cur_cil), c("Ag107Di", "Pr141Di", "Sm147Di", "Eu153Di", "Yb172Di")) expect_equal(names(cur_cil), c("20210305_NE_mockData2_ROI_002_2")) # Read in different channelNames - expect_silent(cur_cil <- readImagefromTXT(path, channel_pattern = "[A-Za-z]{2}[0-9]{3}")) + cur_cil <- readImagefromTXT(path, channel_pattern = "[A-Za-z]{2}[0-9]{3}") + expect_s4_class(cur_cil, "CytoImageList") expect_equal(length(cur_cil), 3) expect_equal(channelNames(cur_cil), c("Ag107", "Pr141", "Sm147", "Eu153", "Yb172")) expect_equal(names(cur_cil), c("20210305_NE_mockData2_ROI_001_1", @@ -61,7 +64,8 @@ test_that("readImagefromTXT function works.", { "20210305_NE_mockData2_ROI_003_3")) # Read in single channel - expect_silent(cur_cil <- readImagefromTXT(path, channel_pattern = "Ag107")) + cur_cil <- readImagefromTXT(path, channel_pattern = "Ag107") + expect_s4_class(cur_cil, "CytoImageList") expect_equal(length(cur_cil), 3) expect_equal(channelNames(cur_cil), c("Ag107")) expect_equal(names(cur_cil), c("20210305_NE_mockData2_ROI_001_1", @@ -75,8 +79,8 @@ test_that("readImagefromTXT function works.", { test_2) # parallelisation - expect_silent(cur_cil <- readImagefromTXT(path, - BPPARAM = BiocParallel::bpparam())) + cur_cil <- readImagefromTXT(path,BPPARAM = BiocParallel::bpparam()) + expect_s4_class(cur_cil, "CytoImageList") expect_equal(length(cur_cil), 3) expect_equal(channelNames(cur_cil), c("Ag107Di", "Pr141Di", "Sm147Di", "Eu153Di", "Yb172Di")) expect_equal(names(cur_cil), c("20210305_NE_mockData2_ROI_001_1", diff --git a/tests/testthat/test_readSCEfromTXT.R b/tests/testthat/test_readSCEfromTXT.R index bc72820b..cc2209e5 100644 --- a/tests/testthat/test_readSCEfromTXT.R +++ b/tests/testthat/test_readSCEfromTXT.R @@ -2,7 +2,8 @@ test_that("readSCEfromTXT function reads in correct objects.", { path <- system.file("extdata/spillover", package = "imcRtools") # Read in .txt - expect_silent(cur_sce <- readSCEfromTXT(path, verbose = FALSE)) + cur_sce <- readSCEfromTXT(path, verbose = FALSE) + expect_s4_class(cur_sce, "SingleCellExperiment") expect_equal(rowData(cur_sce)$channel_name, c("Dy161Di", "Dy162Di", "Dy163Di","Dy164Di")) expect_equal(rowData(cur_sce)$marker_name, c("Dy161", "Dy162", @@ -36,15 +37,17 @@ test_that("readSCEfromTXT function reads in correct objects.", { # Verbose output cur_out <- capture_output(cur_sce <- readSCEfromTXT(path)) - expect_equal(cur_out, "Spotted channels: Dy161, Dy162, Dy163, Dy164\nAcquired channels: Dy161, Dy162, Dy163, Dy164\nChannels spotted but not acquired: \nChannels acquired but not spotted: ") + expect_equal(gsub(".*\nSpotted","Spotted",cur_out), "Spotted channels: Dy161, Dy162, Dy163, Dy164\nAcquired channels: Dy161, Dy162, Dy163, Dy164\nChannels spotted but not acquired: \nChannels acquired but not spotted: ") # Other parameters - expect_silent(cur_sce_2 <- readSCEfromTXT(path, pattern = "Dy162", verbose = FALSE)) + cur_sce_2 <- readSCEfromTXT(path, pattern = "Dy162", verbose = FALSE) + expect_s4_class(cur_sce_2, "SingleCellExperiment") expect_equal(dim(cur_sce_2), c(4, 100)) expect_equal(rowData(cur_sce)$channel_name, c("Dy161Di", "Dy162Di", "Dy163Di","Dy164Di")) - expect_silent(cur_sce_2 <- readSCEfromTXT(path, metadata_cols = "X", verbose = FALSE)) + cur_sce_2 <- readSCEfromTXT(path, metadata_cols = "X", verbose = FALSE) + expect_s4_class(cur_sce_2, "SingleCellExperiment") expect_equal(counts(cur_sce), counts(cur_sce_2)) expect_equal(names(colData(cur_sce_2)), c("X", "sample_id", "sample_metal", "sample_mass" )) @@ -55,7 +58,8 @@ test_that("readSCEfromTXT function reads in correct objects.", { cur_files <- lapply(cur_files, read_delim, delim = "\t") names(cur_files) <- str_extract(cur_files_names, "[A-Za-z]{1,2}[0-9]{2,3}") - expect_silent(cur_sce_3 <- readSCEfromTXT(cur_files, verbose = FALSE)) + cur_sce_3 <- readSCEfromTXT(cur_files, verbose = FALSE) + expect_s4_class(cur_sce_3, "SingleCellExperiment") expect_equal(cur_sce, cur_sce_3) expect_silent(cur_sce_4 <- readSCEfromTXT(cur_files, metadata_cols = "X", verbose = FALSE)) expect_equal(cur_sce_2, cur_sce_4)