From a32ce8f3885ad882d906d7bbf5f381a6995c1250 Mon Sep 17 00:00:00 2001 From: nilseling Date: Mon, 20 Nov 2023 12:28:37 +0100 Subject: [PATCH 1/8] Switched from aes_ to .data --- DESCRIPTION | 2 +- NEWS | 4 +++ R/plotSpatial.R | 3 ++- R/utils.R | 68 ++++++++++++++++++++----------------------------- 4 files changed, 35 insertions(+), 42 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 56f04e4..ed91175 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: imcRtools -Version: 1.9.0 +Version: 1.9.1 Title: Methods for imaging mass cytometry data analysis Description: This R package supports the handling and analysis of imaging mass cytometry diff --git a/NEWS b/NEWS index 7c314c0..8dfc183 100644 --- a/NEWS +++ b/NEWS @@ -213,3 +213,7 @@ Changes in version 1.7.8 (2023-10-19) + spatialCoords are not initialised with rownames anymore +Changes in version 1.9.1 (2023-11-20) + ++ Switched from aes_ to .data + diff --git a/R/plotSpatial.R b/R/plotSpatial.R index efc8f41..f0404fd 100644 --- a/R/plotSpatial.R +++ b/R/plotSpatial.R @@ -133,8 +133,9 @@ #' #' @import ggraph #' @importFrom tidygraph tbl_graph -#' @importFrom ggplot2 aes_ theme element_text element_blank scale_color_manual +#' @importFrom ggplot2 theme element_text element_blank scale_color_manual #' scale_size_manual scale_shape_manual +#' @importFrom rlang .data #' @export plotSpatial <- function(object, img_id, diff --git a/R/utils.R b/R/utils.R index 72f0dd6..ed70fbc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -416,25 +416,26 @@ node_color_fix, node_size_fix, node_shape_fix, edge_color_by, edge_width_by, edge_color_fix, edge_width_fix, nodes_first){ - - node_color_by <- if(is.null(node_color_by)) NULL else as.name(node_color_by) - node_size_by <- if(is.null(node_size_by)) NULL else as.name(node_size_by) - node_shape_by <- if(is.null(node_shape_by)) NULL else as.name(node_shape_by) - edge_color_by <- if(is.null(edge_color_by)) NULL else as.name(edge_color_by) - edge_width_by <- if(is.null(edge_width_by)) NULL else as.name(edge_width_by) - - if (!is.null(node_color_fix)){ node_color_by <- as.character(node_color_fix) - } else { node_color_by <- node_color_by } - if (!is.null(node_size_fix)){ node_size_by <- as.character(node_size_fix) - } else { node_size_by <- node_size_by } - if (!is.null(node_shape_fix)){ node_shape_by <- as.character(node_shape_fix) - } else { node_shape_by <- node_shape_by } - if (!is.null(edge_color_fix)){ edge_color_by <- as.character(edge_color_fix) - } else { edge_color_by <- edge_color_by } - if (!is.null(edge_width_fix)){edge_width_by <- as.character(edge_width_fix) - } else { edge_width_by <- edge_width_by} + + node_mapping <- aes(colour = .data[[node_color_by]], + size = .data[[node_size_by]], + shape = .data[[node_shape_by]]) + if (is.null(node_color_by)) {node_mapping$colour <- NULL} + if (is.null(node_size_by)) {node_mapping$size <- NULL} + if (is.null(node_shape_by)) {node_mapping$shape <- NULL} + if (!is.null(node_color_fix)) {node_mapping$colour <- node_color_fix} + if (!is.null(node_size_fix)) {node_mapping$size <- node_size_fix} + if (!is.null(node_shape_fix)) {node_mapping$shape <- node_shape_fix} if (draw_edges) { + + edge_mapping <- aes(edge_colour = .data[[edge_color_by]], + edge_width = .data[[edge_width_by]]) + if (is.null(edge_color_by)) {edge_mapping$edge_colour <- NULL} + if (is.null(edge_width_by)) {edge_mapping$edge_width <- NULL} + if (!is.null(edge_color_fix)) {edge_mapping$edge_colour <- edge_color_fix} + if (!is.null(edge_width_fix)) {edge_mapping$edge_width <- edge_width_fix} + if (!is.null(arrow)) { if (is.null(end_cap)) { @@ -442,47 +443,34 @@ } if (directed) { - cur_geom_edge <- geom_edge_fan(aes_(edge_colour = edge_color_by, - edge_width = edge_width_by), + cur_geom_edge <- geom_edge_fan(edge_mapping, end_cap = end_cap, arrow = arrow) } else { - cur_geom_edge <- geom_edge_link(aes_( - edge_colour = edge_color_by, - edge_width = edge_width_by), + cur_geom_edge <- geom_edge_link(edge_mapping, end_cap = end_cap, arrow = arrow) } } else { if (directed) { - cur_geom_edge <- geom_edge_fan0(aes_( - edge_colour = edge_color_by, - edge_width = edge_width_by)) + cur_geom_edge <- geom_edge_fan0(edge_mapping) } else { - cur_geom_edge <- geom_edge_link0(aes_( - edge_colour = edge_color_by, - edge_width = edge_width_by)) + cur_geom_edge <- geom_edge_link0(edge_mapping) } } if (nodes_first) { p <- ggraph(layout) + - geom_node_point(aes_(colour = node_color_by, - size = node_size_by, - shape = node_shape_by)) + + geom_node_point(node_mapping) + cur_geom_edge } else { p <- ggraph(layout) + cur_geom_edge + - geom_node_point(aes_(colour = node_color_by, - size = node_size_by, - shape = node_shape_by)) + geom_node_point(node_mapping) } } else { p <- ggraph(layout) + - geom_node_point(aes_(colour = node_color_by, - size = node_size_by, - shape = node_shape_by)) + geom_node_point(node_mapping) } return(p) @@ -1018,7 +1006,7 @@ return(edges) } -#' @importFrom ggplot2 aes_ guide_legend guide_colorbar guides scale_size_manual +#' @importFrom ggplot2 guide_legend guide_colorbar guides scale_size_manual #' @importFrom ggraph geom_edge_link geom_node_label geom_node_point ggraph #' @importFrom igraph layout.sugiyama vertex_attr @@ -1063,9 +1051,9 @@ } if (!is.null(node_color_by)) { - cur_geom_node <- geom_node_point(aes_(color = color, size = size)) + cur_geom_node <- geom_node_point(aes(color = color, size = size)) } else { - cur_geom_node <- geom_node_point(aes_(size = size), color = color) + cur_geom_node <- geom_node_point(aes(size = size), color = color) } ## node geom label From 4e4ba52013166ba2dcb6122f0d32ac2ba371ea44 Mon Sep 17 00:00:00 2001 From: nilseling Date: Mon, 20 Nov 2023 14:59:26 +0100 Subject: [PATCH 2/8] Adjusted aes_ for plotSpatial --- DESCRIPTION | 3 ++- NAMESPACE | 3 ++- R/plotSpatial.R | 2 +- R/utils.R | 10 +++++----- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ed91175..dbe2af3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,7 +56,8 @@ Imports: concaveman, tidyselect, distances, - MatrixGenerics + MatrixGenerics, + rlang Suggests: CATALYST, grid, diff --git a/NAMESPACE b/NAMESPACE index 9c06d00..720e2c5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,7 +86,7 @@ importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(dplyr,sym) -importFrom(ggplot2,aes_) +importFrom(ggplot2,aes) importFrom(ggplot2,coord_fixed) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) @@ -124,6 +124,7 @@ importFrom(methods,is) importFrom(pheatmap,pheatmap) importFrom(readr,cols) importFrom(readr,read_delim) +importFrom(rlang,.data) importFrom(scuttle,aggregateAcrossCells) importFrom(sf,st_area) importFrom(sf,st_buffer) diff --git a/R/plotSpatial.R b/R/plotSpatial.R index f0404fd..bc6b576 100644 --- a/R/plotSpatial.R +++ b/R/plotSpatial.R @@ -134,7 +134,7 @@ #' @import ggraph #' @importFrom tidygraph tbl_graph #' @importFrom ggplot2 theme element_text element_blank scale_color_manual -#' scale_size_manual scale_shape_manual +#' scale_size_manual scale_shape_manual aes #' @importFrom rlang .data #' @export plotSpatial <- function(object, diff --git a/R/utils.R b/R/utils.R index ed70fbc..1eaab1a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -423,9 +423,9 @@ if (is.null(node_color_by)) {node_mapping$colour <- NULL} if (is.null(node_size_by)) {node_mapping$size <- NULL} if (is.null(node_shape_by)) {node_mapping$shape <- NULL} - if (!is.null(node_color_fix)) {node_mapping$colour <- node_color_fix} - if (!is.null(node_size_fix)) {node_mapping$size <- node_size_fix} - if (!is.null(node_shape_fix)) {node_mapping$shape <- node_shape_fix} + if (!is.null(node_color_fix)) {node_mapping$colour <- as.character(node_color_fix)} + if (!is.null(node_size_fix)) {node_mapping$size <- as.character(node_size_fix)} + if (!is.null(node_shape_fix)) {node_mapping$shape <- as.character(node_shape_fix)} if (draw_edges) { @@ -433,8 +433,8 @@ edge_width = .data[[edge_width_by]]) if (is.null(edge_color_by)) {edge_mapping$edge_colour <- NULL} if (is.null(edge_width_by)) {edge_mapping$edge_width <- NULL} - if (!is.null(edge_color_fix)) {edge_mapping$edge_colour <- edge_color_fix} - if (!is.null(edge_width_fix)) {edge_mapping$edge_width <- edge_width_fix} + if (!is.null(edge_color_fix)) {edge_mapping$edge_colour <- as.character(edge_color_fix)} + if (!is.null(edge_width_fix)) {edge_mapping$edge_width <- as.character(edge_width_fix)} if (!is.null(arrow)) { From 06a6977db5bed293106358b0c44324efaee51674 Mon Sep 17 00:00:00 2001 From: nilseling Date: Mon, 20 Nov 2023 16:40:45 +0100 Subject: [PATCH 3/8] Switched from aes_ to .data for plotSpatialContext --- R/utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 1eaab1a..342721b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1065,11 +1065,11 @@ if(node_label_repel){ if (!is.null(node_label_color_by)) { - cur_geom_node_label <- geom_node_label(aes_(color = color_label, + cur_geom_node_label <- geom_node_label(aes(color = color_label, label = vertex_attr(graph, "name")), repel = TRUE, show.legend = FALSE) } else { - cur_geom_node_label <- geom_node_label(aes_(label = vertex_attr(graph, "name")), + cur_geom_node_label <- geom_node_label(aes(label = vertex_attr(graph, "name")), color = color_label, repel = TRUE, show.legend = FALSE) } From 2459a48e8c1aeb9a387ac8b806c785dd225f5496 Mon Sep 17 00:00:00 2001 From: nilseling Date: Mon, 20 Nov 2023 17:36:56 +0100 Subject: [PATCH 4/8] Updated R version for devel --- .github/workflows/build-checks-devel.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build-checks-devel.yml b/.github/workflows/build-checks-devel.yml index 7a734ba..8291942 100644 --- a/.github/workflows/build-checks-devel.yml +++ b/.github/workflows/build-checks-devel.yml @@ -10,7 +10,7 @@ on: jobs: R-CMD-check: runs-on: ubuntu-latest - container: rocker/r-ver:4.3 + container: rocker/r-ver:devel steps: - uses: actions/checkout@v2 From 1dc534e01473e71afe273286019b11a0d5a9b5e7 Mon Sep 17 00:00:00 2001 From: nilseling Date: Tue, 28 Nov 2023 17:14:59 +0100 Subject: [PATCH 5/8] Added tidyr to Suggests --- DESCRIPTION | 4 +++- R/utils.R | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dbe2af3..d514ba4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,10 +57,12 @@ Imports: tidyselect, distances, MatrixGenerics, - rlang + rlang, + grDevices Suggests: CATALYST, grid, + tidyr, BiocStyle, knitr, rmarkdown, diff --git a/R/utils.R b/R/utils.R index 342721b..9f6a4e5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1074,7 +1074,7 @@ repel = TRUE, show.legend = FALSE) } } else { - cur_geom_node_label = NULL + cur_geom_node_label <- NULL } # specify vertical layout with sugiyama From 1bd8483501cababca1bf07e1fc1d4cd4302e6e2f Mon Sep 17 00:00:00 2001 From: nilseling Date: Tue, 12 Dec 2023 16:44:28 +0100 Subject: [PATCH 6/8] Initialize objects with colnames and add check to binAcrossPixels --- NEWS | 2 ++ R/binAcrossPixels.R | 8 ++++++-- R/read_cpout.R | 3 +++ R/read_steinbock.R | 3 +++ 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 8dfc183..3a36587 100644 --- a/NEWS +++ b/NEWS @@ -216,4 +216,6 @@ Changes in version 1.7.8 (2023-10-19) Changes in version 1.9.1 (2023-11-20) + Switched from aes_ to .data ++ Initialise SPE and SCE objects with colnames ++ Additional test within binAcrossPixels diff --git a/R/binAcrossPixels.R b/R/binAcrossPixels.R index 722f278..5e3eb3a 100644 --- a/R/binAcrossPixels.R +++ b/R/binAcrossPixels.R @@ -54,8 +54,12 @@ binAcrossPixels <- function(object, stop("'statistic' must be 'sum', 'mean' or 'median'.") } - cur_split <- split(object[[spot_id]], f = object[[spot_id]]) - cur_split <- lapply(cur_split, function(x){ceiling(seq_along(x)/bin_size)}) + cur_split_tmp <- split(object[[spot_id]], f = object[[spot_id]]) + cur_split <- lapply(cur_split_tmp, function(x){ceiling(seq_along(x)/bin_size)}) + + if (!isTRUE(all.equal(unlist(cur_split_tmp), object[[spot_id]]))) { + stop("Spot IDs of pixels within 'object' are not ordered alphabetically.") + } cur_df <- DataFrame(spot_id = object[[spot_id]], bin = unlist(cur_split)) diff --git a/R/read_cpout.R b/R/read_cpout.R index 373530f..87c0118 100644 --- a/R/read_cpout.R +++ b/R/read_cpout.R @@ -171,5 +171,8 @@ read_cpout <- function(path, object <- .add_panel(object, path, panel_file, extract_metal_from) + # Add colnames + colnames(object) <- paste0(object$sample_id, "_", object$ObjectNumber) + return(object) } diff --git a/R/read_steinbock.R b/R/read_steinbock.R index 178e153..42337ad 100644 --- a/R/read_steinbock.R +++ b/R/read_steinbock.R @@ -161,5 +161,8 @@ read_steinbock <- function(path, # Add panel data object <- .add_panel(object, path, panel_file, extract_names_from) + # Add colnames + colnames(object) <- paste0(object$sample_id, "_", object$ObjectNumber) + return(object) } From fc75f61dc4ef6ca919469fd104f6061b86f3d887 Mon Sep 17 00:00:00 2001 From: nilseling Date: Tue, 12 Dec 2023 18:23:41 +0100 Subject: [PATCH 7/8] Adjusted unit tests --- R/binAcrossPixels.R | 2 +- tests/testthat/test_binAcrossPixels.R | 50 +++++++++++++++++++++++ tests/testthat/test_read_cpout.R | 43 ++++++++++++++++---- tests/testthat/test_read_steinbock.R | 57 ++++++++++++++++++++++----- 4 files changed, 133 insertions(+), 19 deletions(-) diff --git a/R/binAcrossPixels.R b/R/binAcrossPixels.R index 5e3eb3a..ee963c3 100644 --- a/R/binAcrossPixels.R +++ b/R/binAcrossPixels.R @@ -57,7 +57,7 @@ binAcrossPixels <- function(object, cur_split_tmp <- split(object[[spot_id]], f = object[[spot_id]]) cur_split <- lapply(cur_split_tmp, function(x){ceiling(seq_along(x)/bin_size)}) - if (!isTRUE(all.equal(unlist(cur_split_tmp), object[[spot_id]]))) { + if (!isTRUE(all.equal(as.vector(unlist(cur_split_tmp)), object[[spot_id]]))) { stop("Spot IDs of pixels within 'object' are not ordered alphabetically.") } diff --git a/tests/testthat/test_binAcrossPixels.R b/tests/testthat/test_binAcrossPixels.R index 89fd97a..c22d5d9 100644 --- a/tests/testthat/test_binAcrossPixels.R +++ b/tests/testthat/test_binAcrossPixels.R @@ -24,6 +24,30 @@ test_that("binAcrossPixels function works.", { expect_equal(counts(out)[,out$sample_id == "Dy164"][,1], rowSums(counts(cur_sce)[,cur_sce$sample_id == "Dy164"][,1:10])) expect_equal(counts(out)[,out$sample_id == "Dy164"][,2], rowSums(counts(cur_sce)[,cur_sce$sample_id == "Dy164"][,11:20])) + test <- aggregate(t(counts(cur_sce)), by = list(cur_sce$sample_id, rep(rep(1:10, each = 10), 4)), FUN = "sum") + test <- test[order(test$Group.1, test$Group.2),] + + test2 <- counts(out) + test <- t(as.matrix(test[,-c(1,2)])) + + dimnames(test2) <- NULL + dimnames(test) <- NULL + + all.equal(test2, test) + + expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 10, statistic = "mean")) + + test <- aggregate(t(counts(cur_sce)), by = list(cur_sce$sample_id, rep(rep(1:10, each = 10), 4)), FUN = "mean") + test <- test[order(test$Group.1, test$Group.2),] + + test2 <- counts(out) + test <- t(as.matrix(test[,-c(1,2)])) + + dimnames(test2) <- NULL + dimnames(test) <- NULL + + all.equal(test2, test) + # Works expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 2)) expect_s4_class(out, "SingleCellExperiment") @@ -61,6 +85,26 @@ test_that("binAcrossPixels function works.", { expect_equal(counts(out)[,out$sample_id == "Dy164"][,1], rowMeans(counts(cur_sce)[,cur_sce$sample_id == "Dy164"][,1:5])) expect_equal(counts(out)[,out$sample_id == "Dy164"][,2], rowMeans(counts(cur_sce)[,cur_sce$sample_id == "Dy164"][,6:10])) + # Works + expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 3)) + expect_s4_class(out, "SingleCellExperiment") + + # colData are correct + expect_equal(out$sample_id, rep(c("Dy161", "Dy162", "Dy163", "Dy164"), each = 34)) + expect_equal(out$spot_id, rep(c("Dy161", "Dy162", "Dy163", "Dy164"), each = 34)) + expect_equal(as.numeric(out$bin), rep(1:34, 4)) + expect_equal(as.numeric(out$ncells), rep(c(rep(3, 33), 1), 4)) + + # rowData are correct + expect_equal(rowData(cur_sce), rowData(out)) + + # Summarized counts are correct + expect_equal(counts(out)[,1], rowSums(counts(cur_sce)[,1:3])) + expect_equal(counts(out)[,2], rowSums(counts(cur_sce)[,4:6])) + expect_equal(counts(out)[,3], rowSums(counts(cur_sce)[,7:9])) + expect_equal(counts(out)[,4], rowSums(counts(cur_sce)[,10:12])) + expect_equal(counts(out)[,34], counts(cur_sce)[,100]) + # Error expect_error(binAcrossPixels("test"), regexp = "'object' needs to be a SingleCellExperiment object.", @@ -80,4 +124,10 @@ test_that("binAcrossPixels function works.", { expect_error(binAcrossPixels(cur_sce, bin_size = 10, statistic = "test"), regexp = "'statistic' must be 'sum', 'mean' or 'median'.", fixed = TRUE) + + cur_sce <- cur_sce[,sample(ncol(cur_sce))] + + expect_error(binAcrossPixels(cur_sce, bin_size = 10), + regexp = "Spot IDs of pixels within 'object' are not ordered alphabetically.", + fixed = TRUE) }) diff --git a/tests/testthat/test_read_cpout.R b/tests/testthat/test_read_cpout.R index 9976bd4..fefcbd4 100644 --- a/tests/testthat/test_read_cpout.R +++ b/tests/testthat/test_read_cpout.R @@ -5,6 +5,8 @@ test_that("read_cpout function works.", { # SpatialExperiment cur_spe <- read_cpout(path, graph_file = "Object_relationships.csv") + expect_equal(colnames(cur_spe), paste0(cur_spe$sample_id, "_", cur_spe$ObjectNumber)) + expect_s4_class(cur_spe, "SpatialExperiment") expect_equal(rownames(cur_spe), c("Ag107", "Pr141", "Sm147", "Eu153", "Yb172")) @@ -25,7 +27,10 @@ test_that("read_cpout function works.", { image_file <- vroom::vroom(file.path(path, "Image.csv")) object_file <- dplyr::left_join(object_file, image_file, by = "ImageNumber") - expect_equal(counts(cur_spe), cur_counts * (2^16 - 1)) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts * (2^16 - 1)) expect_equal(counts(cur_spe)[1:10], c(0.108695652148605, 0.0217391304297211, 0, 0.0434782608594421, 0.739130434610516, 0, 0, 0, 0, 1.1999999997206)) @@ -68,6 +73,7 @@ test_that("read_cpout function works.", { # SingleCellExperiment cur_sce <- read_cpout(path, return_as = "sce", graph_file = "Object_relationships.csv") + expect_equal(colnames(cur_sce), paste0(cur_sce$sample_id, "_", cur_sce$ObjectNumber)) expect_s4_class(cur_sce, "SingleCellExperiment") @@ -89,7 +95,10 @@ test_that("read_cpout function works.", { image_file <- vroom::vroom(file.path(path, "Image.csv")) object_file <- dplyr::left_join(object_file, image_file, by = "ImageNumber") - expect_equal(counts(cur_sce), cur_counts * (2^16 - 1)) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts * (2^16 - 1)) expect_equal(counts(cur_sce)[1:10], c(0.108695652148605, 0.0217391304297211, 0, 0.0434782608594421, 0.739130434610516, 0, 0, 0, 0, 1.1999999997206)) @@ -146,7 +155,10 @@ test_that("read_cpout function works.", { cur_counts <- t(object_file[,grepl("MeanIntensity_FullStack", colnames(object_file))]) rownames(cur_counts) <- rownames(cur_spe) - expect_equal(counts(cur_spe), cur_counts) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts) expect_equal(counts(cur_spe)[1:10], c(1.65858933621127e-06, 3.31717867242253e-07, 0, 6.63435734484507e-07, 1.12784074862366e-05, 0, 0, 0, 0, 1.83108262717724e-05)) @@ -200,7 +212,10 @@ test_that("read_cpout function works.", { cur_counts <- t(object_file[,grepl("MeanIntensity_FullStack", colnames(object_file))]) rownames(cur_counts) <- rownames(cur_sce) - expect_equal(counts(cur_sce), cur_counts) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts) expect_equal(counts(cur_sce)[1:10], c(1.65858933621127e-06, 3.31717867242253e-07, 0, 6.63435734484507e-07, 1.12784074862366e-05, 0, 0, 0, 0, 1.83108262717724e-05)) @@ -239,7 +254,10 @@ test_that("read_cpout function works.", { cur_counts <- t(object_file[,grepl("MeanIntensity_FullStack", colnames(object_file))]) rownames(cur_counts) <- rownames(cur_spe) - expect_equal(counts(cur_spe), cur_counts) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts) expect_equal(counts(cur_spe)[1:10], c(1.65858933621127e-06, 3.31717867242253e-07, 0, 6.63435734484507e-07, 1.12784074862366e-05, 0, 0, 0, 0, 1.83108262717724e-05)) @@ -281,7 +299,10 @@ test_that("read_cpout function works.", { image_file <- vroom::vroom(file.path(path, "Image.csv")) object_file <- dplyr::left_join(object_file, image_file, by = "ImageNumber") - expect_equal(counts(cur_spe), cur_counts * (2^16 - 1)) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts * (2^16 - 1)) expect_equal(counts(cur_spe)[1:10], c(0.108695652148605, 0.0217391304297211, 0, 0.0434782608594421, 0.739130434610516, 0, 0, 0, 0, 1.1999999997206)) @@ -322,7 +343,10 @@ test_that("read_cpout function works.", { image_file <- vroom::vroom(file.path(path, "Image.csv")) object_file <- dplyr::left_join(object_file, image_file, by = "ImageNumber") - expect_equal(counts(cur_spe), cur_counts * (2^16 - 1)) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts * (2^16 - 1)) expect_equal(counts(cur_spe)[1:10], c(0.108695652148605, 0.0217391304297211, 0, 0.0434782608594421, 0.739130434610516, 0, 0, 0, 0, 1.1999999997206)) @@ -357,7 +381,10 @@ test_that("read_cpout function works.", { image_file <- vroom::vroom(file.path(path, "Image.csv")) object_file <- merge(object_file, image_file, by = "ImageNumber", order = FALSE) - expect_equal(counts(cur_spe), cur_counts * (2^16 - 1)) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, cur_counts * (2^16 - 1)) expect_equal(counts(cur_spe)[1:10], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1)) diff --git a/tests/testthat/test_read_steinbock.R b/tests/testthat/test_read_steinbock.R index 91ebf99..c7df1b9 100644 --- a/tests/testthat/test_read_steinbock.R +++ b/tests/testthat/test_read_steinbock.R @@ -4,6 +4,8 @@ test_that("read_steinbock function works", { # SpatialExperiment cur_spe <- read_steinbock(path) + expect_equal(colnames(cur_spe), paste0(cur_spe$sample_id, "_", cur_spe$ObjectNumber)) + expect_s4_class(cur_spe, "SpatialExperiment") expect_equal(rownames(cur_spe), c("Ag107", "Cytokeratin 5", "Laminin", @@ -23,7 +25,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_spe), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) expect_equal(counts(cur_spe)[1:10], c(0.0909090909090909, 0.181818181818182, 0.0909090909090909, 0.0909090909090909, 0.938306353308938, 0.181163804871695, 0, 0.142857142857143, 0.501448290688651, 1.00346943310329)) @@ -73,6 +78,8 @@ test_that("read_steinbock function works", { # SingleCellExperiment cur_sce <- read_steinbock(path, return_as = "sce") + expect_equal(colnames(cur_sce), paste0(cur_sce$sample_id, "_", cur_sce$ObjectNumber)) + expect_s4_class(cur_sce, "SingleCellExperiment") expect_equal(rownames(cur_sce), c("Ag107", "Cytokeratin 5", "Laminin", @@ -91,7 +98,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_sce), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) expect_equal(counts(cur_sce)[1:10], c(0.0909090909090909, 0.181818181818182, 0.0909090909090909, 0.0909090909090909, 0.938306353308938, 0.181163804871695, 0, 0.142857142857143, 0.501448290688651, 1.00346943310329)) @@ -152,7 +162,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_spe), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_files <- list.files(file.path(path, "regionprops"), full.names = TRUE) cur_morph <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) @@ -203,7 +216,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_sce), t(cur_counts[,-1])) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_files <- list.files(file.path(path, "regionprops"), full.names = TRUE) cur_morph <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) @@ -239,7 +255,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_spe), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_files <- list.files(file.path(path, "regionprops"), full.names = TRUE) cur_morph <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) @@ -282,7 +301,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_sce), t(cur_counts[,-1])) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_files <- list.files(file.path(path, "regionprops"), full.names = TRUE) cur_morph <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) @@ -321,7 +343,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_spe), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) expect_equal(cur_spe$ObjectNumber, cur_counts$Object) @@ -359,7 +384,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_sce), t(cur_counts[,-1])) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_panel <- readr::read_csv(file.path(path, "panel.csv"), show_col_types = FALSE) expect_equal(rowData(cur_sce)$name, cur_panel$name) @@ -373,6 +401,8 @@ test_that("read_steinbock function works", { cur_spe <- read_steinbock(path, pattern = "mockData2") + expect_equal(colnames(cur_spe), paste0(cur_spe$sample_id, "_", cur_spe$ObjectNumber)) + expect_s4_class(cur_spe, "SpatialExperiment") expect_equal(rownames(cur_spe), c("Ag107", "Cytokeratin 5", "Laminin", @@ -391,7 +421,11 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv, show_col_types = FALSE) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_spe), t(cur_counts[,-1])) + test1 <- counts(cur_spe) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) + expect_equal(counts(cur_spe)[1:10], c(0.399655099572807, 0.0344827586206896, 4.64201253035973, 6.50705560733532, 3.57779644892133, 0.428760413080454, 0.0945868939161301, 1.56471130624413, 8.0167475938797, 1.46797196567059)) @@ -455,7 +489,10 @@ test_that("read_steinbock function works", { cur_counts <- lapply(cur_files, readr::read_csv) cur_counts <- do.call("rbind", cur_counts) - expect_equal(counts(cur_sce), t(cur_counts[,-1])) + test1 <- counts(cur_sce) + colnames(test1) <- NULL + + expect_equal(test1, t(cur_counts[,-1])) cur_files <- list.files(file.path(path, "regionprops"), full.names = TRUE, pattern = "mockData2") cur_morph <- lapply(cur_files, readr::read_csv) From 32365f30eb71a035f87af6a9a3338d6ba6bf7d98 Mon Sep 17 00:00:00 2001 From: nilseling Date: Wed, 13 Dec 2023 13:55:54 +0100 Subject: [PATCH 8/8] Switched from all.equal to expect_equal --- tests/testthat/test_binAcrossPixels.R | 4 ++-- tests/testthat/test_findBorderCells.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test_binAcrossPixels.R b/tests/testthat/test_binAcrossPixels.R index c22d5d9..eeb9a1e 100644 --- a/tests/testthat/test_binAcrossPixels.R +++ b/tests/testthat/test_binAcrossPixels.R @@ -33,7 +33,7 @@ test_that("binAcrossPixels function works.", { dimnames(test2) <- NULL dimnames(test) <- NULL - all.equal(test2, test) + expect_equal(test2, test) expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 10, statistic = "mean")) @@ -46,7 +46,7 @@ test_that("binAcrossPixels function works.", { dimnames(test2) <- NULL dimnames(test) <- NULL - all.equal(test2, test) + expect_equal(test2, test) # Works expect_silent(out <- binAcrossPixels(cur_sce, bin_size = 2)) diff --git a/tests/testthat/test_findBorderCells.R b/tests/testthat/test_findBorderCells.R index 53f66a4..6595b8b 100644 --- a/tests/testthat/test_findBorderCells.R +++ b/tests/testthat/test_findBorderCells.R @@ -175,6 +175,6 @@ test_that("findBorderCells function works if cells are not ordered by image", { expect_silent(sce2 <- findBorderCells(sce2, img_id = "ImageNb", border_dist = 10)) plotSpatial(sce2, img_id = "ImageNb", node_color_by = "border_cells") - all.equal(pancreasSCE$border_cells, sce2[,colnames(pancreasSCE)]$border_cells) + expect_equal(pancreasSCE$border_cells, sce2[,colnames(pancreasSCE)]$border_cells) })