From 319e648692c7ca4f8cd702cb67b7f12549313a41 Mon Sep 17 00:00:00 2001 From: bpalau Date: Fri, 21 Jun 2024 12:06:25 +0000 Subject: [PATCH] replace minDistToCells by distToCells --- NAMESPACE | 5 +- R/{minDistToCells.R => distToCells.R} | 113 ++-- R/validityChecks.R | 438 ++++++++-------- man/{minDistToCells.Rd => distToCells.Rd} | 31 +- tests/testthat/test_distToCells.R | 595 ++++++++++++++++++++++ tests/testthat/test_minDistToCells.R | 170 ------- vignettes/imcRtools.Rmd | 35 +- 7 files changed, 922 insertions(+), 465 deletions(-) rename R/{minDistToCells.R => distToCells.R} (59%) mode change 100644 => 100755 mode change 100644 => 100755 R/validityChecks.R rename man/{minDistToCells.Rd => distToCells.Rd} (81%) create mode 100755 tests/testthat/test_distToCells.R delete mode 100644 tests/testthat/test_minDistToCells.R diff --git a/NAMESPACE b/NAMESPACE index 720e2c5..529bbf9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,10 +6,10 @@ export(buildSpatialGraph) export(countInteractions) export(detectCommunity) export(detectSpatialContext) +export(distToCells) export(filterPixels) export(filterSpatialContext) export(findBorderCells) -export(minDistToCells) export(patchDetection) export(patchSize) export(plotSpatial) @@ -30,6 +30,9 @@ importFrom(BiocParallel,SerialParam) importFrom(BiocParallel,bplapply) importFrom(DT,datatable) importFrom(EBImage,Image) +importFrom(MatrixGenerics,rowMaxs) +importFrom(MatrixGenerics,rowMeans) +importFrom(MatrixGenerics,rowMedians) importFrom(MatrixGenerics,rowMins) importFrom(RTriangle,pslg) importFrom(RTriangle,triangulate) diff --git a/R/minDistToCells.R b/R/distToCells.R old mode 100644 new mode 100755 similarity index 59% rename from R/minDistToCells.R rename to R/distToCells.R index 935244f..0d1f186 --- a/R/minDistToCells.R +++ b/R/distToCells.R @@ -1,9 +1,9 @@ -#' @title Function to calculate minimal distance to cells of interest -#' -#' @description Function to return the distance of the closest cell of interest +#' @title Function to calculate distance to cells of interest +#' +#' @description Function to return the min, max, mean or median distance to the cells of interest #' for each cell in the data. In the case of patched/clustered cells negative #' distances are returned by default which indicate the distance of the cells -#' of interest to the closest cell that is not of the type of cells of +#' of interest to the cells that are not of the type of cells of #' interest. #' #' @param object a \code{SingleCellExperiment} or \code{SpatialExperiment} @@ -13,6 +13,8 @@ #' distances will be calculated. #' @param name character specifying the name of the \code{colData} entry to safe #' the distances in. +#' @param metric one of "min", "max", "mean" or "meadian" specifying the distance metric to use when computing +#' the distances. #' @param coords character vector of length 2 specifying the names of the #' \code{colData} (for a \code{SingleCellExperiment} object) or the #' \code{spatialCoords} entries of the cells' x and y locations. @@ -22,26 +24,26 @@ #' returned for the distances of patched/spatially clustered cells. #' @param BPPARAM a \code{\link[BiocParallel]{BiocParallelParam-class}} object #' defining how to parallelize computations. -#' +#' #' @section Ordering of the output object: #' The \code{minDistToCells} function operates on individual images. -#' Therefore the returned object is grouped by entries in \code{img_id}. +#' Therefore the returned object is grouped by entries in \code{img_id}. #' This means all cells of a given image are grouped together in the object. #' The ordering of cells within each individual image is the same as the ordering #' of these cells in the input object. -#' -#' @return returns an object of \code{class(object)} containing a new column +#' +#' @return returns an object of \code{class(object)} containing a new column #' entry to \code{colData(object)[[name]]}. Cells in the object are grouped #' by entries in \code{img_id}. -#' +#' #' @examples #' library(cytomapper) #' data(pancreasSCE) -#' +#' #' # Build interaction graph #' pancreasSCE <- buildSpatialGraph(pancreasSCE, img_id = "ImageNb", #' type = "expansion",threshold = 20) -#' +#' #' # Detect patches of "celltype_B" cells #' pancreasSCE <- patchDetection(pancreasSCE, #' img_id = "ImageNb", @@ -50,15 +52,16 @@ #' min_patch_size = 20, #' expand_by = 1) #' -#' plotSpatial(pancreasSCE, -#' img_id = "ImageNb", +#' plotSpatial(pancreasSCE, +#' img_id = "ImageNb", #' node_color_by = "patch_id", #' scales = "free") #' #' # Distance to celltype_B patches -#' pancreasSCE <- minDistToCells(pancreasSCE, +#' pancreasSCE <- distToCells(pancreasSCE, #' x_cells = !is.na(pancreasSCE$patch_id), #' coords = c("Pos_X","Pos_Y"), +#' metric = "min", #' img_id = "ImageNb") #' #' plotSpatial(pancreasSCE, @@ -66,70 +69,68 @@ #' node_color_by = "distToCells", #' scales = "free") #' -#' @author Daniel Schulz (\email{daniel.schulz@@uzh.ch}) +#' @author Daniel Schulz & Bruno Palau (\email{daniel.schulz@@uzh.ch}) #' @importFrom distances distances distance_columns -#' @importFrom MatrixGenerics rowMins +#' @importFrom MatrixGenerics rowMins rowMaxs rowMeans rowMedians #' @export -minDistToCells <- function(object, - x_cells, - img_id, - name = "distToCells", - coords = c("Pos_X","Pos_Y"), - return_neg = TRUE, - BPPARAM = SerialParam()){ - - .valid.minDistToCells.input(object,x_cells,name,coords,img_id,return_neg) - +distToCells <- function (object, + x_cells, + img_id, + name = "distToCells", + coords = c("Pos_X","Pos_Y"), + metric="min", + return_neg = TRUE, + BPPARAM = SerialParam()){ + .valid.distToCells.input(object, x_cells, name, coords, metric, + img_id, return_neg) cur_meta <- metadata(object) metadata(object) <- list() - cur_intmeta <- int_metadata(object) - object$x_cells <- x_cells - cur_out <- bplapply( unique(colData(object)[[img_id]]), - function(x){ - - cur_obj <- object[,as.character(colData(object)[[img_id]]) == x] - + function(x) { + cur_obj <- object[, as.character(colData(object)[[img_id]]) == x] cur_obj[[name]] <- NA - if (sum(cur_obj$x_cells) == 0 | sum(cur_obj$x_cells) == ncol(cur_obj)) { + if (sum(cur_obj$x_cells) == 0 | sum(cur_obj$x_cells) == + ncol(cur_obj)) { return(cur_obj) } - patch_cells <- which(cur_obj$x_cells) non_patch_cells <- which(!cur_obj$x_cells) - if (is(object, "SpatialExperiment")) { dist_mat <- distances(spatialCoords(cur_obj)) - } else { - dist_mat <- distances(as.matrix(colData(cur_obj)[,coords])) } - - pos_dist <- distance_columns(dist_mat,column_indices = patch_cells) - dist_to_patch <- rowMins(pos_dist) - neg_dist <- distance_columns(dist_mat,column_indices = non_patch_cells) - dist_from_patch <- rowMins(neg_dist) - - # cells that had a 0 distance to the cells of interest can be substitutes - # with the negative distances from the cells of interest - if(return_neg == TRUE) { - dist_to_patch[dist_to_patch == 0] <- -dist_from_patch[dist_to_patch == 0] + else { + dist_mat <- distances::distances(as.matrix(colData(cur_obj)[, + coords])) + } + pos_dist <- distance_columns(dist_mat, column_indices = patch_cells) + neg_dist <- distance_columns(dist_mat, column_indices = non_patch_cells) + dist_to_patch <- switch(metric, + mean = rowMeans(pos_dist), + median = rowMedians(pos_dist), + min = rowMins(pos_dist), + max = rowMaxs(pos_dist)) + + + if (return_neg == TRUE) { + dist_from_patch <- switch(metric, + mean = rowMeans(neg_dist), + median = rowMedians(neg_dist), + min = rowMins(neg_dist), + max = rowMaxs(neg_dist)) + + dist_to_patch[cur_obj$x_cells] <- -dist_from_patch[cur_obj$x_cells] } cur_obj[[name]] <- dist_to_patch - return(cur_obj) }, BPPARAM = BPPARAM) - cur_out <- do.call("cbind", cur_out) - cur_out$x_cells <- NULL - metadata(cur_out) <- cur_meta int_metadata(cur_out) <- cur_intmeta - - message("The returned object is ordered by the '", img_id, "' entry.") - + message("The returned object is ordered by the '", img_id, + "' entry.") return(cur_out) -} \ No newline at end of file +} diff --git a/R/validityChecks.R b/R/validityChecks.R old mode 100644 new mode 100755 index 7222fb6..5b3e034 --- a/R/validityChecks.R +++ b/R/validityChecks.R @@ -9,18 +9,18 @@ if (read_metal_from_filename) { cur_mass <- str_extract(cur_names, "[0-9]{2,3}$") cur_names <- cur_names[order(as.numeric(cur_mass))] - + if (!all(grepl("^[A-Z]{1}[a-z]{0,1}[0-9]{2,3}$", cur_names))) { stop("Not all names match the pattern (mt)(mass).") } - + # Check if spotted channel is also open cur_channels <- str_extract(colnames(txt_list[[1]]), "[A-Z]{1}[a-z]{0,1}[0-9]{2,3}Di") cur_channels <- cur_channels[!is.na(cur_channels)] cur_channels <- sub("Di", "", cur_channels) - - # Verbose option will print possible missmatched between acquired and + + # Verbose option will print possible missmatched between acquired and # open channels spot_not_ac <- cur_names[!(cur_names %in% cur_channels)] ac_not_spot <- cur_channels[!(cur_channels %in% cur_names)] @@ -35,7 +35,7 @@ cat("Channels acquired but not spotted: ", paste(ac_not_spot, collapse = ", ")) } - + if (!all(cur_names %in% cur_channels)) { stop("Not all spotted channels were acquired.") } @@ -75,7 +75,7 @@ stop("'log' needs to be logical.") } - if (!is.null(threshold) & (length(threshold) != 1 || + if (!is.null(threshold) & (length(threshold) != 1 || !all(is.numeric(threshold)))) { stop("'threshold' needs to be a single numeric.") } @@ -173,37 +173,37 @@ if (!dir.exists(file.path(path, intensities_folder))) { stop("'intensities_folder' doesn't exist.") } - + # Check if any files can be read in all_files <- list.files(file.path(path, intensities_folder), pattern = pattern, full.names = TRUE) - + if (length(all_files) == 0) { stop("No files were read in.") } - + # Check cell_id cur_file <- vroom(all_files[1], progress = FALSE, show_col_types = FALSE) - + if (length(cell_id) != 1 | !is.character(cell_id)) { stop("'extract_cellid_from' must be a single string.") } - + if (!cell_id %in% colnames(cur_file)) { stop("'extract_cellid_from' not in intensities files.") } - + cur_int <- lapply(all_files, function(x){ x <- vroom(x, n_max = 0, show_col_types = FALSE) return(colnames(x)) }) - + if (length(unique(cur_int)) != 1) { stop("'colnames' of files in '", intensities_folder, "' do not match.") } - + all_int <- list.files(file.path(path, intensities_folder), pattern = pattern, full.names = FALSE) @@ -216,23 +216,23 @@ if (!dir.exists(file.path(path, graphs_folder))) { stop("'graphs_folder' doesn't exist.") } - + all_graph <- list.files(file.path(path, graphs_folder), pattern = pattern, full.names = FALSE) - + if (!identical(all_int, all_graph)) { - stop("File names in '", intensities_folder, "' and '", + stop("File names in '", intensities_folder, "' and '", graphs_folder, "' do not match.") } - + all_files <- list.files(file.path(path, graphs_folder), pattern = pattern, full.names = TRUE) - + cur_graphs <- lapply(all_files, function(x){ x <- vroom(x, n_max = 0, show_col_types = FALSE) return(colnames(x)) }) - + if (length(unique(cur_graphs)) != 1) { stop("'colnames' of files in '", graphs_folder, "' do not match.") } @@ -241,7 +241,7 @@ if (!is.null(regionprops_folder)) { - if (length(regionprops_folder) != 1 | + if (length(regionprops_folder) != 1 | !is.character(regionprops_folder)) { stop("'regionprops_folder' must be a single string.") } @@ -249,12 +249,12 @@ if (!dir.exists(file.path(path, regionprops_folder))) { stop("'regionprops_folder' doesn't exist.") } - + all_region <- list.files(file.path(path, regionprops_folder), pattern = pattern, full.names = FALSE) - + if (!identical(all_int, all_region)) { - stop("File names in '", intensities_folder, "' and '", + stop("File names in '", intensities_folder, "' and '", regionprops_folder, "' do not match.") } @@ -264,63 +264,63 @@ if (!is.null(regionprops_folder)) { all_files <- list.files(file.path(path, regionprops_folder), pattern = pattern, full.names = TRUE) - + if (length(all_files) > 0) { cur_file <- vroom(all_files[1], progress = FALSE, show_col_types = FALSE) - + if (!all(is.character(coords))) { stop("'extract_coords_from' must be characters.") } - + if (!all(coords %in% colnames(cur_file))) { stop("'coords' not in regionprops files.") } - + cur_region <- lapply(all_files, function(x){ x <- vroom(x, n_max = 0, show_col_types = FALSE) return(colnames(x)) }) - + if (length(unique(cur_region)) != 1) { stop("'colnames' of files in '", regionprops_folder, "' do not match.") } } } - + # Check image file if (!is.null(image_file)) { if (length(image_file) != 1 | !is.character(image_file)) { stop("'image_file' must be a single string.") } - + if (!file.exists(file.path(path, image_file))) { stop("'image_file' doesn't exist.") } - + if (!all(is.character(extract_imagemetadata_from))) { stop("'extract_imagemetadata_from' should only contain characters.") } - - cur_images_file <- vroom(file.path(path, image_file), progress = FALSE, + + cur_images_file <- vroom(file.path(path, image_file), progress = FALSE, show_col_types = FALSE) - + if (!all(extract_imagemetadata_from %in% colnames(cur_images_file))) { stop("'extract_imagemetadata_from' not in images file.") } - + # Compare against intensity files all_int <- list.files(file.path(path, intensities_folder), pattern = pattern, full.names = FALSE) - + cur_sample_id <- sub("\\.[^.]*$", "", all_int) - + if (!all(cur_sample_id %in% sub("\\.[^.]*$", "", cur_images_file$image))) { - stop("Files found in '", intensities_folder, + stop("Files found in '", intensities_folder, "' do not match the 'image' entry in '", image_file, "'.") } - } + } # Check panel if (!is.null(panel)) { @@ -354,12 +354,12 @@ #' @importFrom stringr str_count .valid.read_cpout.input <- function(path, object_file, image_file, panel_file, graph_file, object_feature_file, - intensities, extract_imgid_from, + intensities, extract_imgid_from, extract_cellid_from, extract_coords_from, - extract_cellmetadata_from, + extract_cellmetadata_from, extract_imagemetadata_from, - extract_graphimageid_from, + extract_graphimageid_from, extract_graphcellids_from, extract_metal_from, scale_intensities, extract_scalingfactor_from){ @@ -442,7 +442,7 @@ stop("'extract_metal_from' must be specified.") } - if (length(extract_metal_from) != 1 | + if (length(extract_metal_from) != 1 | !is.character(extract_metal_from)) { stop("'extract_metal_from' must be a single string.") } @@ -454,7 +454,7 @@ } # Check object files - cur_file <- vroom(file.path(path, object_file), n_max = 1, + cur_file <- vroom(file.path(path, object_file), n_max = 1, show_col_types = FALSE) if (is.null(intensities)) { @@ -477,7 +477,7 @@ cur_channels <- as.numeric(table(cur_channels)) if (any(cur_channels > 1)) { - stop("Some of the features set via 'intensities'", + stop("Some of the features set via 'intensities'", " cannot be uniquely accessed.") } @@ -537,7 +537,7 @@ } if (!is.null(image_file)) { - cur_file <- vroom(file.path(path, image_file), n_max = 1, + cur_file <- vroom(file.path(path, image_file), n_max = 1, show_col_types = FALSE) if (!is.null(extract_imagemetadata_from)) { @@ -546,12 +546,12 @@ } } - if (length(extract_scalingfactor_from) != 1 | + if (length(extract_scalingfactor_from) != 1 | !is.character(extract_scalingfactor_from)) { stop("'extract_scalingfactor_from' must be a single string.") } - if (scale_intensities & + if (scale_intensities & !extract_scalingfactor_from %in% colnames(cur_file)) { stop("'extract_scalingfactor_from' not in 'image_file'.") } @@ -560,14 +560,14 @@ # Check graph file if (!is.null(graph_file)) { - cur_file <- vroom(file.path(path, graph_file), n_max = 1, + cur_file <- vroom(file.path(path, graph_file), n_max = 1, show_col_types = FALSE) if (is.null(extract_graphimageid_from)) { stop("'extract_graphimageid_from' must be specified.") } - if (length(extract_graphimageid_from) != 1 | + if (length(extract_graphimageid_from) != 1 | !is.character(extract_graphimageid_from)) { stop("'extract_graphimageid_from' must be a single string.") } @@ -589,8 +589,8 @@ } #' @importFrom SpatialExperiment spatialCoordsNames -.valid.buildSpatialGraph.input <- function(object, type, img_id, k, - threshold, coords, name, +.valid.buildSpatialGraph.input <- function(object, type, img_id, k, + threshold, coords, name, directed, max_dist){ if (!is(object, "SingleCellExperiment")) { @@ -611,11 +611,11 @@ stop("When constructing a graph via expansion,", " please specify 'threshold'.") } - + if (length(threshold) != 1 || !is.numeric(threshold)) { stop("'threshold' must be a single numeric") } - + } if (type == "knn") { @@ -624,16 +624,16 @@ stop("When constructing a graph via nearest neighbour detection, ", "please specify 'k'.") } - + if (length(k) != 1 || !is.numeric(k)) { stop("'k' must be a single numeric") } - - if (!is.null(max_dist) & (length(max_dist) != 1 || + + if (!is.null(max_dist) & (length(max_dist) != 1 || !is.numeric(max_dist))) { stop("'max_dist' must be a single numeric") } - + } if (length(coords) != 2 | !all(is.character(coords))) { @@ -664,22 +664,22 @@ } -.valid.aggregateNeighbors.input <- function(object, colPairName, aggregate_by, - count_by, proportions, assay_type, +.valid.aggregateNeighbors.input <- function(object, colPairName, aggregate_by, + count_by, proportions, assay_type, subset_row, name){ if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + if (length(colPairName) != 1 | !is.character(colPairName)) { stop("'colPairName' must be a single string.") } - + if (! colPairName %in% colPairNames(object)) { stop("'colPairName' not in 'colPairNames(object)'.") } - + if (length(colPair(object, colPairName)) == 0) { stop("No interactions found.") } @@ -689,7 +689,7 @@ if (is.null(count_by)) { stop("Provide a 'colData(object)' entry to aggregate by.") } - + if (length(count_by) != 1 | !is.character(count_by)) { stop("'count_by' must be a single string.") } @@ -697,7 +697,7 @@ if (! count_by %in% colnames(colData(object))) { stop("'count_by' is not a valid enty of 'colData(object)'.") } - + if (length(proportions) != 1 | !is.logical(proportions)) { stop("'proportions' must be a single logical") } @@ -708,7 +708,7 @@ if (is.null(assay_type)) { stop("'assay_type' not provided") } - + if (length(assay_type) != 1 | !is.character(assay_type)) { stop("'assay_type' must be a single string.") } @@ -716,21 +716,21 @@ if (! assay_type %in% assayNames(object)) { stop("'assay_type' not an assay in the 'object'.") } - + if (!is.null(subset_row)) { - if (all(is.character(subset_row)) & + if (all(is.character(subset_row)) & !all(subset_row %in% rownames(object))) { stop("'subset_row' not in rownames(object).") } - - if (all(is.logical(subset_row)) & + + if (all(is.logical(subset_row)) & length(subset_row) != nrow(object)) { - stop("'subset_row' logical entries", + stop("'subset_row' logical entries", " must be as long as 'nrow(object)'.") } } } - + if (!is.null(name) & (length(name) != 1 | !is.character(name))) { stop("'name' must be a single string.") } @@ -739,11 +739,11 @@ #' @importFrom S4Vectors mcols .valid.plotSpatial.input <- function(object, img_id, coords, node_color_by, node_shape_by, node_size_by, edge_color_by, - assay_type, edge_width_by, draw_edges, - directed, arrow, end_cap, colPairName, - nodes_first, ncols, nrows, scales, + assay_type, edge_width_by, draw_edges, + directed, arrow, end_cap, colPairName, + nodes_first, ncols, nrows, scales, flip_x, flip_y, aspect_ratio){ - + if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } @@ -759,7 +759,7 @@ if (length(coords) != 2 | !all(is.character(coords))) { stop("'coords' must be a character vector of length 2.") } - + if (is(object, "SpatialExperiment")) { if (!all(coords %in% spatialCoordsNames(object))) { stop("'coords' not in spatialCoords(object).") @@ -774,23 +774,23 @@ !is.character(node_color_by))) { stop("'node_color_by' must be a single string.") } - + cur_accepted <- c(names(colData(object)), rownames(object)) if (!is.null(node_color_by) && !node_color_by %in% cur_accepted) { stop("'node_color_by' not in colData(object) or rownames(object).") } - + if (!is.null(node_color_by) && node_color_by %in% rownames(object)) { if (is.null(assay_type)) { - stop("When coloring nodes by marker expression,", + stop("When coloring nodes by marker expression,", " please specify 'assay_type'.") } - + if (length(assay_type) != 1 | !is.character(assay_type)) { stop("'assay_type' must be a single string.") } - + if (!assay_type %in% assayNames(object)) { stop("'assay_type' not an assay in object.") } @@ -845,16 +845,16 @@ stop("'edge_color_by' not in 'colData(object)'", " or in 'mcols(colPair(object, colPairName))'.") } - - if (!is.null(edge_width_by) && + + if (!is.null(edge_width_by) && (length(edge_width_by) != 1 | !is.character(edge_width_by))) { stop("'edge_width_by' must be a single string.") } - - if (!is.null(edge_width_by) && + + if (!is.null(edge_width_by) && (!edge_width_by %in% names(colData(object)) && !edge_width_by %in% names(mcols(colPair(object, colPairName))))) { - stop("'edge_width_by' not in 'colData(object)'", + stop("'edge_width_by' not in 'colData(object)'", " or in 'mcols(colPair(object, colPairName))'.") } @@ -865,12 +865,12 @@ if (!is.null(arrow) && !is(arrow, "arrow")) { stop("'arrow' must be of class grid::arrow.") } - + if (!is.null(end_cap) && !is(end_cap, "ggraph_geometry")) { stop("'end_cap' must be of type 'ggraph_geometry'.") } } - + if (length(nodes_first) != 1 | !is.logical(nodes_first)) { stop("'nodes_first' must be a single logical") } @@ -882,77 +882,77 @@ if (!is.null(nrows) && (length(nrows) != 1 | !is.numeric(nrows))) { stop("'nrows' must be a single numeric") } - + if (!scales %in% c("fixed", "free_x", "free_y", "free")) { stop("'scales' should be one of 'fixed', 'free_x', 'free_y', 'free'.") } - + if (length(flip_y) != 1 | !is.logical(flip_y)) { stop("'flip_y' must be a single logical") } - + if (length(flip_x) != 1 | !is.logical(flip_x)) { stop("'flip_x' must be a single logical") } - + if (!is.null(aspect_ratio) & length(aspect_ratio) != 1) { stop("'aspect_ratio' must be a single positive number, NULL or 'auto'.") } - + if (!is.null(aspect_ratio)) { if (aspect_ratio != "auto" & - (!is.numeric(aspect_ratio) | + (!is.numeric(aspect_ratio) | any(aspect_ratio < 0))) { stop("'aspect_ratio' must be a single positive number, NULL or 'auto'.") } } - + } .valid.countInteractions.input <- function(object, group_by, label, method, patch_size, colPairName){ - + if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + if (length(group_by) != 1 | !is.character(group_by)) { stop("'group_by' must be a single string.") } - + if (any(is.na(object[[group_by]]))) { stop("Please remove NAs from the grouping vector.") } - + if (!group_by %in% names(colData(object))) { stop("'group_by' not in colData(object).") } - + if (length(colPairName) != 1 | !is.character(colPairName)) { stop("'colPairName' must be a single string.") } - + if (!colPairName %in% colPairNames(object)) { stop("'colPairName' not in colPairNames(object).") } - + if (length(label) != 1 | !is.character(label)) { stop("'label' must be a single string.") } - + if (!label %in% names(colData(object))) { stop("'label' not in colData(object).") } - + if (any(is.na(object[[label]]))) { stop("Please remove NAs from the label vector.") } - + if (method == "patch") { if (is.null(patch_size)) { stop("When method = 'patch', please specify 'patch_size'.") } - + if (length(patch_size) != 1 | !is.numeric(patch_size)) { stop("'patch_size' must be a single numeric.") } @@ -964,27 +964,27 @@ if (length(iter) != 1 | !is.numeric(iter)) { stop("'iter' must be a single positive numeric.") } - + if (iter < 1) { stop("'iter' must be a single positive numeric.") } - + if (length(p_threshold) != 1 | !is.numeric(p_threshold)) { stop("'p_threshold' must be a single numeric between 0 and 1.") } - + if (p_threshold < 0 | p_threshold > 1) { stop("'p_threshold' must be a single numeric between 0 and 1.") } - + if (length(return_samples) != 1 | !is.logical(return_samples)) { stop("'return_samples' must be a single logical.") } - + if (length(tolerance) != 1 | !is.numeric(tolerance)) { stop("'tolerance' must be a single numeric.") } - + if (tolerance < 0) { stop("'tolerance' must be larger than 0.") } @@ -994,19 +994,19 @@ if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + if (length(img_id) != 1 | !is.character(img_id)) { stop("'img_id' must be a single string.") } - + if (!img_id %in% names(colData(object))) { stop("'img_id' not in colData(object).") } - + if (length(coords) != 2 | !all(is.character(coords))) { stop("'coords' must be a character vector of length 2.") } - + if (is(object, "SpatialExperiment")) { if (!all(coords %in% spatialCoordsNames(object))) { stop("'coords' not in spatialCoords(object).") @@ -1016,47 +1016,47 @@ stop("'coords' not in colData(object).") } } - + if (length(border_dist) != 1 | !is.numeric(border_dist)) { stop("'border_dist' must be a single numeric.") } } -.valid.patchDetection.input <- function(object, patch_cells, colPairName, +.valid.patchDetection.input <- function(object, patch_cells, colPairName, min_patch_size, name, expand_by, coords, convex, img_id){ if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + if (!all(is.logical(patch_cells))) { stop("'patch_cells' must all be logical.") } - + if (length(patch_cells) != ncol(object)) { stop("Length of 'patch_cells' must match the number of cells in 'object'.") } - + if (length(colPairName) != 1 | !is.character(colPairName)) { stop("'colPairName' must be a single string.") } - + if (! colPairName %in% colPairNames(object)) { stop("'colPairName' not in 'colPairNames(object)'.") } - + if (length(colPair(object, colPairName)) == 0) { stop("No interactions found.") } - + if (length(min_patch_size) != 1 | !is.numeric(min_patch_size)) { stop("'min_patch_size' must be a single numeric.") } - + if (length(coords) != 2 | !all(is.character(coords))) { stop("'coords' must be a character vector of length 2.") } - + if (is(object, "SpatialExperiment")) { if (!all(coords %in% spatialCoordsNames(object))) { stop("'coords' not in spatialCoords(object).") @@ -1066,55 +1066,63 @@ stop("'coords' not in colData(object).") } } - + if (length(name) != 1 | !is.character(name)) { stop("'name' must be a single string.") } - + if (length(expand_by) != 1 | !is.numeric(expand_by)) { stop("'expand_by' must be a single numeric.") } - + if (length(convex) != 1 | !is.logical(convex)) { stop("'convex' must be a single logical.") } - + if (expand_by > 0) { if (is.null(img_id)) { stop("'img_id' must be specified when patch expansion is performed.") } - + if (length(img_id) != 1 | !is.character(img_id)) { stop("'img_id' must be a single string.") } - + if (!img_id %in% names(colData(object))) { stop("'img_id' not in colData(object).") } } } -.valid.minDistToCells.input <- function(object,x_cells,name,coords,img_id,return_neg){ +.valid.distToCells.input <- function(object,x_cells,name,coords,metric,img_id,return_neg){ if(!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + + if(ncol(object) == 0) { + stop("'object' must contain at least one cell") + } + if (!all(is.logical(x_cells))) { stop("'x_cells' must all be logical.") } - + if (length(x_cells) != ncol(object)) { stop("Length of 'x_cells' must match the number of cells in 'object'.") } - + if (length(name) != 1 | !is.character(name)) { stop("'name' must be a single string.") } - + + if (!metric %in% c("min", "max", "mean", "median")){ + stop("'metric' not supported. Must be one of 'min', 'max', 'mean' or 'median'") + } + if (length(coords) != 2 | !all(is.character(coords))) { stop("'coords' must be a character vector of length 2.") } - + if (is(object, "SpatialExperiment")) { if (!all(coords %in% spatialCoordsNames(object))) { stop("'coords' not in spatialCoords(object).") @@ -1124,15 +1132,15 @@ stop("'coords' not in colData(object).") } } - + if (length(img_id) != 1 | !is.character(img_id)) { stop("'img_id' must be a single string.") } - + if (!img_id %in% names(colData(object))) { stop("'img_id' not in colData(object).") } - + if(!is.logical(return_neg)){ stop("'return_neg' is not of type logical.") } @@ -1142,19 +1150,19 @@ if (!is(object, "SingleCellExperiment")) { stop("'object' not of type 'SingleCellExperiment'.") } - + if (length(patch_name) != 1 | !is.character(patch_name)) { stop("'patch_name' must be a single string.") } - + if (!patch_name %in% names(colData(object))) { stop("'patch_name' nor in 'colData(object)'.") } - + if (length(coords) != 2 | !all(is.character(coords))) { stop("'coords' must be a character vector of length 2.") } - + if (is(object, "SpatialExperiment")) { if (!all(coords %in% spatialCoordsNames(object))) { stop("'coords' not in spatialCoords(object).") @@ -1164,7 +1172,7 @@ stop("'coords' not in colData(object).") } } - + if (length(convex) != 1 | !is.logical(convex)) { stop("'convex' must be a single logical.") } @@ -1177,59 +1185,59 @@ if (!is(object, "SingleCellExperiment")) { stop("'object' needs to be a SingleCellExperiment object.") } - + if (!entry %in% names(colData(object))) { stop("'entry' not in 'colData(object)'.") } - + if (!is(colData(object)[,entry],"DFrame")) { stop("'colData(object)[,entry]' needs to be a DFrame object.") } - + if (!(is.numeric(threshold) & (0 <= threshold && threshold <= 1))){ stop("'threshold' needs to be a single numeric between 0-1.") } - + if (length(name) != 1 | !is.character(name)) { stop("'name' has to be a single character'.") } } -.valid.filterSpatialContext.input <- function(object, - entry, +.valid.filterSpatialContext.input <- function(object, + entry, group_by, group_threshold, - cells_threshold, + cells_threshold, name){ - + if (!is(object, "SingleCellExperiment")) { stop("'object' needs to be a SingleCellExperiment object.") } - + if (!entry %in% names(colData(object))) { stop("'entry' not in 'colData(object)'.") } - - if (!group_by %in% names(colData(object))) { + + if (!group_by %in% names(colData(object))) { stop("'group_by' not in 'colData(object)'.") } - + if (!is.null(group_threshold) && (!is.numeric(group_threshold) | length(group_threshold) != 1)){ stop("'group_threshold' needs to be a single numeric.") } - + if (!is.null(cells_threshold) && (!is.numeric(cells_threshold) | length(cells_threshold) != 1)){ stop("'cells_threshold' needs to be a single numeric.") } - + if (is.null(group_threshold) && (is.null(cells_threshold))) { - stop("One of 'group_threshold' and 'cells_threshold' ", + stop("One of 'group_threshold' and 'cells_threshold' ", "has to be defined.") } - + if (length(name) != 1 | !is.character(name)) { stop("'name' has to be a single character'.") } @@ -1238,151 +1246,151 @@ .valid.plotSpatialContext.input <- function(object, entry, group_by, - node_color_by, + node_color_by, node_size_by, node_color_fix, node_size_fix, node_label_repel, node_label_color_by, - node_label_color_fix, + node_label_color_fix, draw_edges, edge_color_fix, return_data){ if (!is(object, "SingleCellExperiment")) { stop("'object' needs to be a SingleCellExperiment object.") } - + if (!entry %in% names(colData(object))) { stop("'entry' not in 'colData(object)'.") } - - if (!group_by %in% names(colData(object))) { + + if (!group_by %in% names(colData(object))) { stop("'group_by' not in 'colData(object)'.") } - + if (!is.null(node_color_by) && (!node_color_by %in% c("name", "n_cells", "n_group"))){ stop("'node_color_by' has to be one off 'name', 'n_cells' or 'n_group'.") } - + if (!is.null(node_size_by) && (!node_size_by %in% c("n_cells", "n_group"))){ stop("'node_size_by' has to be 'n_cells' or 'n_group'.") } - - if (!is.null(node_label_color_by) && + + if (!is.null(node_label_color_by) && (!node_label_color_by %in% c("name","n_cells","n_group"))){ stop("'node_label_color_by' has to be one off 'name', 'n_cells' or 'n_group'.") } - + if (!is.logical(node_label_repel)) { stop("'node_label_repel' has to be logical'.") } - + if(node_label_repel == FALSE){ if(!is.null(node_label_color_by) | (!is.null(node_label_color_fix))){ - stop("'node_label_color_by' and 'node_label_color_fix' can not be defined ", + stop("'node_label_color_by' and 'node_label_color_fix' can not be defined ", "when node_label_repel == FALSE") - }} - + }} + if (!is.logical(draw_edges)) { stop("'draw_edges' has to be logical'.") } - - if (!is.null(node_color_fix) && + + if (!is.null(node_color_fix) && (!is.character(node_color_fix))){ stop("'node_color_fix' has to be a character'.") } - + if (!is.null(node_size_fix) && (!is.character(node_size_fix))){ stop("'node_size_fix' has to be a character'.") } - + if (!is.null(node_label_color_fix) && (!is.character(node_label_color_fix))){ stop("'node_label_color_fix' has to be a character'.") } - + if (!is.null(edge_color_fix) && (!is.character(edge_color_fix))){ stop("'edge_color_fix' has to be a character'.") } - + if(!is.null(node_color_by) && (!is.null(node_color_fix))){ - stop("'node_color_by' and 'node_color_fix' can not be defined ", + stop("'node_color_by' and 'node_color_fix' can not be defined ", "at the same time.") } - + if(!is.null(node_label_color_by) && (!is.null(node_label_color_fix))){ - stop("'node_label_color_by' and 'node_label_color_fix' can not be defined ", + stop("'node_label_color_by' and 'node_label_color_fix' can not be defined ", "at the same time.") - } - + } + if(!is.null(node_label_color_by) && - (!is.null(node_color_by)) && + (!is.null(node_color_by)) && (node_label_color_by != node_color_by)){ stop("'node_label_color_by' and 'node_color_by' have to be identical.") } - + if(!is.null(node_size_by) && (!is.null(node_size_fix))){ - stop("'node_size_by' and 'node_size_fix' can not be defined ", + stop("'node_size_by' and 'node_size_fix' can not be defined ", "at the same time.") - } - + } + if (!is.logical(return_data)) { stop("'return_data' has to be logical'.") } } -.valid.detectCommunity.input <- function(object, - colPairName, - size_threshold, - group_by, - name, +.valid.detectCommunity.input <- function(object, + colPairName, + size_threshold, + group_by, + name, cluster_fun){ - - + + if (!is(object, "SingleCellExperiment")) { stop("'object' needs to be a SingleCellExperiment object.") - } - - if (is.null(colnames(object)) | + } + + if (is.null(colnames(object)) | length(unique(colnames(object))) != length(colnames(object))) { stop("'colnames' of 'object' need to be specified and unique (e.g. as cell IDs).") - } - + } + if (length(colPairName) != 1 | !is.character(colPairName)) { stop("'colPairName' must be a single string.") } - + if (! colPairName %in% colPairNames(object)) { stop("'colPairName' not in 'colPairNames(object)'.") } - + if (length(colPair(object, colPairName)) == 0) { stop("No interactions found.") } - - if (!is.numeric(size_threshold) | length(size_threshold) != 1 + + if (!is.numeric(size_threshold) | length(size_threshold) != 1 | size_threshold < 0){ stop("'size_threshold' needs to be a positive single numeric.") } - + if (!is.null(group_by) && - (!group_by %in% names(colData(object)))) { + (!group_by %in% names(colData(object)))) { stop("'group_by' not in 'colData(object)'.") } - + if (length(name) != 1 | !is.character(name)) { stop("'name' has to be a single character.") } - + if (length(cluster_fun) != 1 | !is.character(cluster_fun)) { stop("'cluster_fun' has to be a single character.") } -} +} diff --git a/man/minDistToCells.Rd b/man/distToCells.Rd similarity index 81% rename from man/minDistToCells.Rd rename to man/distToCells.Rd index a7b826d..1bf0d5f 100644 --- a/man/minDistToCells.Rd +++ b/man/distToCells.Rd @@ -1,15 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/minDistToCells.R -\name{minDistToCells} -\alias{minDistToCells} -\title{Function to calculate minimal distance to cells of interest} +% Please edit documentation in R/distToCells.R +\name{distToCells} +\alias{distToCells} +\title{Function to calculate distance to cells of interest} \usage{ -minDistToCells( +distToCells( object, x_cells, img_id, name = "distToCells", coords = c("Pos_X", "Pos_Y"), + metric = "min", return_neg = TRUE, BPPARAM = SerialParam() ) @@ -32,6 +33,9 @@ the distances in.} \code{colData} (for a \code{SingleCellExperiment} object) or the \code{spatialCoords} entries of the cells' x and y locations.} +\item{metric}{one of "min", "max", "mean" or "meadian" specifying the distance metric to use when computing +the distances.} + \item{return_neg}{logical indicating whether negative distances are to be returned for the distances of patched/spatially clustered cells.} @@ -39,21 +43,21 @@ returned for the distances of patched/spatially clustered cells.} defining how to parallelize computations.} } \value{ -returns an object of \code{class(object)} containing a new column +returns an object of \code{class(object)} containing a new column entry to \code{colData(object)[[name]]}. Cells in the object are grouped by entries in \code{img_id}. } \description{ -Function to return the distance of the closest cell of interest +Function to return the min, max, mean or median distance to the cells of interest for each cell in the data. In the case of patched/clustered cells negative distances are returned by default which indicate the distance of the cells -of interest to the closest cell that is not of the type of cells of +of interest to the cells that are not of the type of cells of interest. } \section{Ordering of the output object}{ The \code{minDistToCells} function operates on individual images. -Therefore the returned object is grouped by entries in \code{img_id}. +Therefore the returned object is grouped by entries in \code{img_id}. This means all cells of a given image are grouped together in the object. The ordering of cells within each individual image is the same as the ordering of these cells in the input object. @@ -75,15 +79,16 @@ pancreasSCE <- patchDetection(pancreasSCE, min_patch_size = 20, expand_by = 1) -plotSpatial(pancreasSCE, - img_id = "ImageNb", +plotSpatial(pancreasSCE, + img_id = "ImageNb", node_color_by = "patch_id", scales = "free") # Distance to celltype_B patches -pancreasSCE <- minDistToCells(pancreasSCE, +pancreasSCE <- distToCells(pancreasSCE, x_cells = !is.na(pancreasSCE$patch_id), coords = c("Pos_X","Pos_Y"), + metric = "min", img_id = "ImageNb") plotSpatial(pancreasSCE, @@ -93,5 +98,5 @@ plotSpatial(pancreasSCE, } \author{ -Daniel Schulz (\email{daniel.schulz@uzh.ch}) +Daniel Schulz & Bruno Palau (\email{daniel.schulz@uzh.ch}) } diff --git a/tests/testthat/test_distToCells.R b/tests/testthat/test_distToCells.R new file mode 100755 index 0000000..af0a29a --- /dev/null +++ b/tests/testthat/test_distToCells.R @@ -0,0 +1,595 @@ +test_that("distToCells works",{ + library(cytomapper) + data("pancreasSCE") + + # min + # works when cell types present and with negative distances returned + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(class(cur_sce$distToCells) == "numeric") + expect_true(min(cur_sce$distToCells) < 0) + expect_true(sum(cur_sce$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_B")) + + # works on cell types when present and no negative distances returned + expect_message(cur_sce_2 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_2, "SingleCellExperiment")) + expect_s4_class(cur_sce_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_2))) + expect_true(class(cur_sce_2$distToCells) == "numeric") + expect_true(min(cur_sce_2$distToCells) == 0) + expect_true(sum(cur_sce_2$distToCells == 0) >= sum(pancreasSCE$CellType == "celltype_B")) + + expect_equal(cur_sce[,cur_sce$distToCells > 0]$distToCells,cur_sce_2[,cur_sce_2$distToCells > 0]$distToCells) + + expect_equal(length(cur_sce[,cur_sce$distToCells < 0]),length(cur_sce_2[,cur_sce_2$distToCells == 0])) + + # works on cell types when not present in some image and with negative distances returned + expect_message(cur_sce_3 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_3, "SingleCellExperiment")) + expect_s4_class(cur_sce_3 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_3))) + expect_true(is(cur_sce_3$distToCells, "numeric")) + expect_true(sum(cur_sce_3$distToCells[cur_sce_3$ImageName != "J02_imc.tiff"] < 0) == sum(pancreasSCE$CellType == "celltype_A")) + + expect_true(any(is.na(cur_sce_3$distToCells))) + expect_true(all(is.na(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_3[,!is.na(cur_sce_3$distToCells)]$distToCells)<0) + + expect_equal(length(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_3$distToCells))) + + # works on cell types when not present in some images and no negative distances returned + expect_message(cur_sce_4 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_4, "SingleCellExperiment")) + expect_s4_class(cur_sce_4 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_4))) + expect_true(is(cur_sce_4$distToCells, "numeric")) + expect_true(sum(cur_sce_4$distToCells[cur_sce_4$ImageName != "J02_imc.tiff"] < 0) == 0) + + expect_true(any(is.na(cur_sce_4$distToCells))) + expect_true(all(is.na(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_4[,!is.na(cur_sce_4$distToCells)]$distToCells) == 0) + + expect_equal(length(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_4$distToCells))) + + # Spatial Experiment + cur_spe <- SpatialExperiment:::.sce_to_spe(pancreasSCE, sample_id = as.character(pancreasSCE$ImageNb)) + spatialCoords(cur_spe) <- as.matrix(colData(pancreasSCE)[,c("Pos_X", "Pos_Y")]) + colData(cur_spe)[c("Pos_X", "Pos_Y")] <- NULL + + cur_spe_1 <- distToCells(cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName") + + expect_true(is(cur_spe_1, "SingleCellExperiment")) + expect_s4_class(cur_spe_1 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_1))) + expect_true(class(cur_spe_1$distToCells) == "numeric") + expect_true(min(cur_spe_1$distToCells) < 0) + + # works on cell types when present and no negative distances returned + expect_message(cur_spe_2 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_spe_2, "SingleCellExperiment")) + expect_s4_class(cur_spe_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_2))) + expect_true(class(cur_spe_2$distToCells) == "numeric") + expect_true(min(cur_spe_2$distToCells) == 0) + + expect_equal(cur_spe_1[,cur_spe_1$distToCells > 0]$distToCells,cur_spe_2[,cur_spe_2$distToCells > 0]$distToCells) + + expect_equal(length(cur_spe_1[,cur_spe_1$distToCells < 0]),length(cur_spe_2[,cur_spe_2$distToCells == 0])) + + # compare results from SingleCellExperiment and SpatialExperiment + expect_equal(cur_sce$distToCells,cur_spe_1$distToCells) + + expect_equal(cur_sce_2$distToCells,cur_spe_2$distToCells) + + # Works when all cells of an image belong to one batch + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$ImageName == "J02_imc.tiff", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells))) + + cur_sce$CellType[cur_sce$ImageName == "J02_imc.tiff"] <- "celltype_A" + expect_message(cur_sce <- distToCells(object = cur_sce, + x_cells = cur_sce$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "min", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells[cur_sce$ImageName == "J02_imc.tiff"]))) + expect_true(all(!is.na(cur_sce$distToCells[cur_sce$ImageName != "J02_imc.tiff"]))) + + # max + # works when cell types present and with negative distances returned + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(class(cur_sce$distToCells) == "numeric") + expect_true(min(cur_sce$distToCells) < 0) + expect_true(sum(cur_sce$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_B")) + # TODO: for all cases, enforces that a cells not of interest and a cell of interect do not have the same exact coordinates + + # works on cell types when present and no negative distances returned + expect_message(cur_sce_2 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_2, "SingleCellExperiment")) + expect_s4_class(cur_sce_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_2))) + expect_true(class(cur_sce_2$distToCells) == "numeric") + + expect_equal(cur_sce[,!pancreasSCE$CellType == "celltype_B"]$distToCells,cur_sce_2[,!pancreasSCE$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_sce$distToCells < 0),sum(pancreasSCE$CellType == "celltype_B")) + + # works on cell types when not present in some image and with negative distances returned + expect_message(cur_sce_3 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_3, "SingleCellExperiment")) + expect_s4_class(cur_sce_3 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_3))) + expect_true(is(cur_sce_3$distToCells, "numeric")) + expect_true(sum(cur_sce_3[,cur_sce_3$ImageName != "J02_imc.tiff"]$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_A")) + + expect_true(any(is.na(cur_sce_3$distToCells))) + expect_true(all(is.na(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_3[,!is.na(cur_sce_3$distToCells)]$distToCells)<0) + + expect_equal(length(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_3$distToCells))) + + # works on cell types when not present in some images and no negative distances returned + expect_message(cur_sce_4 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_4, "SingleCellExperiment")) + expect_s4_class(cur_sce_4 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_4))) + expect_true(is(cur_sce_4$distToCells, "numeric")) + expect_true(sum(cur_sce_4[,cur_sce_4$ImageName != "J02_imc.tiff"]$distToCells < 0) == 0) + + expect_true(any(is.na(cur_sce_4$distToCells))) + expect_true(all(is.na(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_4[,!is.na(cur_sce_4$distToCells)]$distToCells) > 0) + + expect_equal(length(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_4$distToCells))) + + # Spatial Experiment + cur_spe <- SpatialExperiment:::.sce_to_spe(pancreasSCE, sample_id = as.character(pancreasSCE$ImageNb)) + spatialCoords(cur_spe) <- as.matrix(colData(pancreasSCE)[,c("Pos_X", "Pos_Y")]) + colData(cur_spe)[c("Pos_X", "Pos_Y")] <- NULL + + cur_spe_1 <- distToCells(cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName") + + expect_true(is(cur_spe_1, "SingleCellExperiment")) + expect_s4_class(cur_spe_1 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_1))) + expect_true(class(cur_spe_1$distToCells) == "numeric") + expect_true(min(cur_spe_1$distToCells) < 0) + + # works on cell types when present and no negative distances returned + expect_message(cur_spe_2 <- distToCells(object = cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_spe_2, "SingleCellExperiment")) + expect_s4_class(cur_spe_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_2))) + expect_true(class(cur_spe_2$distToCells) == "numeric") + expect_true(min(cur_spe_2$distToCells) > 0) + + expect_equal(cur_spe_1[,!cur_spe$CellType == "celltype_B"]$distToCells,cur_spe_2[,!cur_spe$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_spe_1$distToCells < 0),sum(cur_spe$CellType == "celltype_B")) + + # compare results from SingleCellExperiment and SpatialExperiment + expect_equal(cur_sce$distToCells,cur_spe_1$distToCells) + + expect_equal(cur_sce_2$distToCells,cur_spe_2$distToCells) + + # Works when all cells of an image belong to one batch + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$ImageName == "J02_imc.tiff", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells))) + + cur_sce$CellType[cur_sce$ImageName == "J02_imc.tiff"] <- "celltype_A" + expect_message(cur_sce <- distToCells(object = cur_sce, + x_cells = cur_sce$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "max", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells[cur_sce$ImageName == "J02_imc.tiff"]))) + expect_true(all(!is.na(cur_sce$distToCells[cur_sce$ImageName != "J02_imc.tiff"]))) + + + # mean + # works when cell types present and with negative distances returned + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(class(cur_sce$distToCells) == "numeric") + expect_true(min(cur_sce$distToCells) < 0) + expect_true(sum(cur_sce$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_B")) + # TODO: for all cases, enforces that a cells not of interest and a cell of interect do not have the same exact coordinates + + # works on cell types when present and no negative distances returned + expect_message(cur_sce_2 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_2, "SingleCellExperiment")) + expect_s4_class(cur_sce_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_2))) + expect_true(class(cur_sce_2$distToCells) == "numeric") + + expect_equal(cur_sce[,!pancreasSCE$CellType == "celltype_B"]$distToCells,cur_sce_2[,!pancreasSCE$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_sce$distToCells < 0),sum(pancreasSCE$CellType == "celltype_B")) + + # works on cell types when not present in some image and with negative distances returned + expect_message(cur_sce_3 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_3, "SingleCellExperiment")) + expect_s4_class(cur_sce_3 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_3))) + expect_true(is(cur_sce_3$distToCells, "numeric")) + expect_true(sum(cur_sce_3[,cur_sce_3$ImageName != "J02_imc.tiff"]$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_A")) + + expect_true(any(is.na(cur_sce_3$distToCells))) + expect_true(all(is.na(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_3[,!is.na(cur_sce_3$distToCells)]$distToCells)<0) + + expect_equal(length(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_3$distToCells))) + + # works on cell types when not present in some images and no negative distances returned + expect_message(cur_sce_4 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_4, "SingleCellExperiment")) + expect_s4_class(cur_sce_4 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_4))) + expect_true(is(cur_sce_4$distToCells, "numeric")) + expect_true(sum(cur_sce_4[,cur_sce_4$ImageName != "J02_imc.tiff"]$distToCells < 0) == 0) + + expect_true(any(is.na(cur_sce_4$distToCells))) + expect_true(all(is.na(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_4[,!is.na(cur_sce_4$distToCells)]$distToCells) > 0) + + expect_equal(length(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_4$distToCells))) + + # Spatial Experiment + cur_spe <- SpatialExperiment:::.sce_to_spe(pancreasSCE, sample_id = as.character(pancreasSCE$ImageNb)) + spatialCoords(cur_spe) <- as.matrix(colData(pancreasSCE)[,c("Pos_X", "Pos_Y")]) + colData(cur_spe)[c("Pos_X", "Pos_Y")] <- NULL + + cur_spe_1 <- distToCells(cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName") + + expect_true(is(cur_spe_1, "SingleCellExperiment")) + expect_s4_class(cur_spe_1 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_1))) + expect_true(class(cur_spe_1$distToCells) == "numeric") + expect_true(min(cur_spe_1$distToCells) < 0) + + # works on cell types when present and no negative distances returned + expect_message(cur_spe_2 <- distToCells(object = cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_spe_2, "SingleCellExperiment")) + expect_s4_class(cur_spe_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_2))) + expect_true(class(cur_spe_2$distToCells) == "numeric") + expect_true(min(cur_spe_2$distToCells) > 0) + + expect_equal(cur_spe_1[,!cur_spe$CellType == "celltype_B"]$distToCells,cur_spe_2[,!cur_spe$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_spe_1$distToCells < 0),sum(cur_spe$CellType == "celltype_B")) + + # compare results from SingleCellExperiment and SpatialExperiment + expect_equal(cur_sce$distToCells,cur_spe_1$distToCells) + + expect_equal(cur_sce_2$distToCells,cur_spe_2$distToCells) + + # Works when all cells of an image belong to one batch + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$ImageName == "J02_imc.tiff", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells))) + + cur_sce$CellType[cur_sce$ImageName == "J02_imc.tiff"] <- "celltype_A" + expect_message(cur_sce <- distToCells(object = cur_sce, + x_cells = cur_sce$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells[cur_sce$ImageName == "J02_imc.tiff"]))) + expect_true(all(!is.na(cur_sce$distToCells[cur_sce$ImageName != "J02_imc.tiff"]))) + + + # median + # works when cell types present and with negative distances returned + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(class(cur_sce$distToCells) == "numeric") + expect_true(min(cur_sce$distToCells) < 0) + expect_true(sum(cur_sce$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_B")) + # TODO: for all cases, enforces that a cells not of interest and a cell of interect do not have the same exact coordinates + + # works on cell types when present and no negative distances returned + expect_message(cur_sce_2 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_2, "SingleCellExperiment")) + expect_s4_class(cur_sce_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_2))) + expect_true(class(cur_sce_2$distToCells) == "numeric") + + expect_equal(cur_sce[,!pancreasSCE$CellType == "celltype_B"]$distToCells,cur_sce_2[,!pancreasSCE$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_sce$distToCells < 0),sum(pancreasSCE$CellType == "celltype_B")) + + # works on cell types when not present in some image and with negative distances returned + expect_message(cur_sce_3 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_3, "SingleCellExperiment")) + expect_s4_class(cur_sce_3 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_3))) + expect_true(is(cur_sce_3$distToCells, "numeric")) + expect_true(sum(cur_sce_3[,cur_sce_3$ImageName != "J02_imc.tiff"]$distToCells < 0) == sum(pancreasSCE$CellType == "celltype_A")) + + expect_true(any(is.na(cur_sce_3$distToCells))) + expect_true(all(is.na(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_3[,!is.na(cur_sce_3$distToCells)]$distToCells)<0) + + expect_equal(length(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_3$distToCells))) + + # works on cell types when not present in some images and no negative distances returned + expect_message(cur_sce_4 <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_sce_4, "SingleCellExperiment")) + expect_s4_class(cur_sce_4 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce_4))) + expect_true(is(cur_sce_4$distToCells, "numeric")) + expect_true(sum(cur_sce_4[,cur_sce_4$ImageName != "J02_imc.tiff"]$distToCells < 0) == 0) + + expect_true(any(is.na(cur_sce_4$distToCells))) + expect_true(all(is.na(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$distToCells))) + expect_true(min(cur_sce_4[,!is.na(cur_sce_4$distToCells)]$distToCells) > 0) + + expect_equal(length(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_4$distToCells))) + + # Spatial Experiment + cur_spe <- SpatialExperiment:::.sce_to_spe(pancreasSCE, sample_id = as.character(pancreasSCE$ImageNb)) + spatialCoords(cur_spe) <- as.matrix(colData(pancreasSCE)[,c("Pos_X", "Pos_Y")]) + colData(cur_spe)[c("Pos_X", "Pos_Y")] <- NULL + + cur_spe_1 <- distToCells(cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName") + + expect_true(is(cur_spe_1, "SingleCellExperiment")) + expect_s4_class(cur_spe_1 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_1))) + expect_true(class(cur_spe_1$distToCells) == "numeric") + expect_true(min(cur_spe_1$distToCells) < 0) + + # works on cell types when present and no negative distances returned + expect_message(cur_spe_2 <- distToCells(object = cur_spe, + x_cells = cur_spe$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName", + return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_true(is(cur_spe_2, "SingleCellExperiment")) + expect_s4_class(cur_spe_2 , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_spe_2))) + expect_true(class(cur_spe_2$distToCells) == "numeric") + expect_true(min(cur_spe_2$distToCells) > 0) + + expect_equal(cur_spe_1[,!cur_spe$CellType == "celltype_B"]$distToCells,cur_spe_2[,!cur_spe$CellType == "celltype_B"]$distToCells) + + expect_equal(sum(cur_spe_1$distToCells < 0),sum(cur_spe$CellType == "celltype_B")) + + # compare results from SingleCellExperiment and SpatialExperiment + expect_equal(cur_sce$distToCells,cur_spe_1$distToCells) + + expect_equal(cur_sce_2$distToCells,cur_spe_2$distToCells) + + # Works when all cells of an image belong to one batch + expect_message(cur_sce <- distToCells(object = pancreasSCE, + x_cells = pancreasSCE$ImageName == "J02_imc.tiff", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells))) + + cur_sce$CellType[cur_sce$ImageName == "J02_imc.tiff"] <- "celltype_A" + expect_message(cur_sce <- distToCells(object = cur_sce, + x_cells = cur_sce$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + metric = "median", + img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") + expect_s4_class(cur_sce , class = "SingleCellExperiment") + expect_true("distToCells" %in% names(colData(cur_sce))) + expect_true(all(is.na(cur_sce$distToCells[cur_sce$ImageName == "J02_imc.tiff"]))) + expect_true(all(!is.na(cur_sce$distToCells[cur_sce$ImageName != "J02_imc.tiff"]))) + + + # Error + expect_error(cur_sce_4 <- distToCells(object = pancreasSCE[,pancreasSCE$ImageName == "J02_imc.tiff"], + x_cells = pancreasSCE$CellType == "celltype_A", + coords = c("Pos_X","Pos_Y"), + img_id = "ImageName", + return_neg = FALSE), + regexp = "Length of 'x_cells' must match the number of cells in 'object'.") + + expect_error(distToCells(object = "test"), + regexp = "'object' not of type 'SingleCellExperiment'.", + fixed = TRUE) + expect_error(distToCells(object = pancreasSCE[,pancreasSCE$ImageName == "test"], x_cells = pancreasSCE[,pancreasSCE$ImageName == "test"]$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"), + img_id = "ImageName",return_neg = TRUE), + regexp = "'object' must contain at least one cell", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = "test"), + regexp = "'x_cells' must all be logical.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = TRUE), + regexp = "Length of 'x_cells' must match the number of cells in 'object'.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = TRUE), + regexp = "'name' must be a single string.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = 1), + regexp = "'name' must be a single string.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",metric = "test"), + regexp = "'metric' not supported. Must be one of 'min', 'max', 'mean' or 'median'", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c(1,2)), + regexp = "'coords' must be a character vector of length 2.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("A","B")), + regexp = "'coords' not in colData(object).", + fixed = TRUE) + expect_error(distToCells(cur_spe, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("A","B")), + regexp = "'coords' not in spatialCoords(object).", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"),img_id = 1), + regexp = "'img_id' must be a single string.", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"),img_id = "test"), + regexp = "'img_id' not in colData(object).", + fixed = TRUE) + expect_error(distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"), + img_id = "ImageName",return_neg = 1), + regexp = "'return_neg' is not of type logical.", + fixed = TRUE) + expect_error(distToCells(cur_spe, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_1","Pos_Y")), + regexp = "'coords' not in spatialCoords(object).", + fixed = TRUE) +}) + + diff --git a/tests/testthat/test_minDistToCells.R b/tests/testthat/test_minDistToCells.R deleted file mode 100644 index 7002dab..0000000 --- a/tests/testthat/test_minDistToCells.R +++ /dev/null @@ -1,170 +0,0 @@ -test_that("minDistToCells works",{ - data("pancreasSCE") - - # works when cell types present and with negative distances returned - expect_message(cur_sce <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$CellType == "celltype_B", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_s4_class(cur_sce , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce))) - expect_true(class(cur_sce$distToCells) == "numeric") - expect_true(min(cur_sce$distToCells) < 0) - - # works on cell types when present and no negative distances returned - expect_message(cur_sce_2 <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$CellType == "celltype_B", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName", - return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_true(is(cur_sce_2, "SingleCellExperiment")) - expect_s4_class(cur_sce_2 , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce_2))) - expect_true(class(cur_sce_2$distToCells) == "numeric") - expect_true(min(cur_sce_2$distToCells) == 0) - - expect_equal(cur_sce[,cur_sce$distToCells > 0]$distToCells,cur_sce_2[,cur_sce_2$distToCells > 0]$distToCells) - - expect_equal(length(cur_sce[,cur_sce$distToCells < 0]),length(cur_sce_2[,cur_sce_2$distToCells == 0])) - - # works on cell types when not present in some image and with negative distances returned - expect_message(cur_sce_3 <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$CellType == "celltype_A", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_true(is(cur_sce_3, "SingleCellExperiment")) - expect_s4_class(cur_sce_3 , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce_3))) - expect_true(is(cur_sce_3$distToCells, "numeric")) - - expect_true(any(is.na(cur_sce_3$distToCells))) - expect_true(all(is.na(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$distToCells))) - expect_true(min(cur_sce_3[,!is.na(cur_sce_3$distToCells)]$distToCells)<0) - - expect_equal(length(cur_sce_3[,cur_sce_3$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_3$distToCells))) - - # works on cell types when not present in some images and no negative distances returned - expect_message(cur_sce_4 <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$CellType == "celltype_A", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName", - return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_true(is(cur_sce_4, "SingleCellExperiment")) - expect_s4_class(cur_sce_4 , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce_4))) - expect_true(is(cur_sce_4$distToCells, "numeric")) - - expect_true(any(is.na(cur_sce_4$distToCells))) - expect_true(all(is.na(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$distToCells))) - expect_true(min(cur_sce_4[,!is.na(cur_sce_4$distToCells)]$distToCells) == 0) - - expect_equal(length(cur_sce_4[,cur_sce_4$ImageName == "J02_imc.tiff"]$CellNb),sum(is.na(cur_sce_4$distToCells))) - - # Spatial Experiment - cur_spe <- SpatialExperiment:::.sce_to_spe(pancreasSCE, sample_id = as.character(pancreasSCE$ImageNb)) - spatialCoords(cur_spe) <- as.matrix(colData(pancreasSCE)[,c("Pos_X", "Pos_Y")]) - colData(cur_spe)[c("Pos_X", "Pos_Y")] <- NULL - - cur_spe_1 <- minDistToCells(cur_spe, - x_cells = cur_spe$CellType == "celltype_B", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName") - - expect_true(is(cur_spe_1, "SingleCellExperiment")) - expect_s4_class(cur_spe_1 , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_spe_1))) - expect_true(class(cur_spe_1$distToCells) == "numeric") - expect_true(min(cur_spe_1$distToCells) < 0) - - # works on cell types when present and no negative distances returned - expect_message(cur_spe_2 <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$CellType == "celltype_B", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName", - return_neg = FALSE), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_true(is(cur_spe_2, "SingleCellExperiment")) - expect_s4_class(cur_spe_2 , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_spe_2))) - expect_true(class(cur_spe_2$distToCells) == "numeric") - expect_true(min(cur_spe_2$distToCells) == 0) - - expect_equal(cur_spe_1[,cur_spe_1$distToCells > 0]$distToCells,cur_spe_2[,cur_spe_2$distToCells > 0]$distToCells) - - expect_equal(length(cur_spe_1[,cur_spe_1$distToCells < 0]),length(cur_spe_2[,cur_spe_2$distToCells == 0])) - - # compare results from SingleCellExperiment and SpatialExperiment - expect_equal(cur_sce$distToCells,cur_spe_1$distToCells) - - expect_equal(cur_sce_2$distToCells,cur_spe_2$distToCells) - - # Works when all cells of an image belog to one batch - expect_message(cur_sce <- minDistToCells(object = pancreasSCE, - x_cells = pancreasSCE$ImageName == "J02_imc.tiff", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") - - expect_s4_class(cur_sce , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce))) - expect_true(all(is.na(cur_sce$distToCells))) - - cur_sce$CellType[cur_sce$ImageName == "J02_imc.tiff"] <- "celltype_A" - expect_message(cur_sce <- minDistToCells(object = cur_sce, - x_cells = cur_sce$CellType == "celltype_A", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName"), regexp = "The returned object is ordered by the 'ImageName' entry.") - expect_s4_class(cur_sce , class = "SingleCellExperiment") - expect_true("distToCells" %in% names(colData(cur_sce))) - expect_true(all(is.na(cur_sce$distToCells[cur_sce$ImageName == "J02_imc.tiff"]))) - expect_true(all(!is.na(cur_sce$distToCells[cur_sce$ImageName != "J02_imc.tiff"]))) - - # Error - expect_error(cur_sce_4 <- minDistToCells(object = pancreasSCE[,pancreasSCE$ImageName == "J02_imc.tiff"], - x_cells = pancreasSCE$CellType == "celltype_A", - coords = c("Pos_X","Pos_Y"), - img_id = "ImageName", - return_neg = FALSE), - regexp = "Length of 'x_cells' must match the number of cells in 'object'.") - - expect_error(minDistToCells(object = "test"), - regexp = "'object' not of type 'SingleCellExperiment'.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = "test"), - regexp = "'x_cells' must all be logical.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = TRUE), - regexp = "Length of 'x_cells' must match the number of cells in 'object'.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = TRUE), - regexp = "'name' must be a single string.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = 1), - regexp = "'name' must be a single string.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c(1,2)), - regexp = "'coords' must be a character vector of length 2.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("A","B")), - regexp = "'coords' not in colData(object).", - fixed = TRUE) - expect_error(minDistToCells(cur_spe, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("A","B")), - regexp = "'coords' not in spatialCoords(object).", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"),img_id = 1), - regexp = "'img_id' must be a single string.", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"),img_id = "test"), - regexp = "'img_id' not in colData(object).", - fixed = TRUE) - expect_error(minDistToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_X","Pos_Y"), - img_id = "ImageName",return_neg = 1), - regexp = "'return_neg' is not of type logical.", - fixed = TRUE) - expect_error(minDistToCells(cur_spe, x_cells = pancreasSCE$CellType == "celltype_B",name = "test",coords = c("Pos_1","Pos_Y")), - regexp = "'coords' not in spatialCoords(object).", - fixed = TRUE) -}) diff --git a/vignettes/imcRtools.Rmd b/vignettes/imcRtools.Rmd index 1723834..44e169c 100644 --- a/vignettes/imcRtools.Rmd +++ b/vignettes/imcRtools.Rmd @@ -948,30 +948,45 @@ For each patch larger than 2 cells, the spatial area can be computed using the patchSize(pancreasSCE) ``` -## Minimal distances to cells of interest +## Distance metric to cells of interest -Calculate the minimal distance for each cell to a given cell type or class of -cells of interest, the function `minDistToCells` is available. Cells of interest +Calculate the min, max, mean or median distance for each cell to a given cell type or class of +cells of interest, the function `distToCells` is available. Cells of interest are defined via the `x_cells` parameter as `logical` and distances to for all cells to those cells will be reported in a new column in the `colData` of the `SingleCellExperiment`. If the cells of interest form patches (many cells of the same type next to each other) or similarly if a patch detection has previously been performed the -positive distances reflect the distances from cells outside of patches to the -closest patch border and the negative distances reflect the distances from cells -inside the patches to the patch border. If `return_neg` is set to `FALSE` -negative distances are set to 0. +positive distances reflect the distances from cells outside of patches (or non cells of interest) to the patch cells (or cells of interest) and the negative distances reflect the distances from cells +inside the patches to the cells outside the patches. +For `metric` = "min" this corresponds to the distance from the cells outside to the closest point on the patch border and from the cells inside to the closest point on the patch border. +If `return_neg` is set to `FALSE`, distances from the cells of interest (or cells inside the patches) to non cells of interest are computed as positive distances. -```{r minDistToCells} -pancreasSCE <- minDistToCells(pancreasSCE, +```{r distToCells} +pancreasSCE <- distToCells(pancreasSCE, x_cells = pancreasSCE$CellType == "celltype_B", coords = c("Pos_X","Pos_Y"), + metric = "min", + name = "minDist", img_id = "ImageNb") +pancreasSCE <- distToCells(pancreasSCE, + x_cells = pancreasSCE$CellType == "celltype_B", + coords = c("Pos_X","Pos_Y"), + metric = "mean", + name = "meanDist", + img_id = "ImageNb") + +plotSpatial(pancreasSCE, + img_id = "ImageNb", + node_color_by = "minDist", + scales = "free") + + scale_color_viridis() + plotSpatial(pancreasSCE, img_id = "ImageNb", - node_color_by = "distToCells", + node_color_by = "meanDist", scales = "free") + scale_color_viridis() ```