Skip to content

Commit

Permalink
Merge d54aced into bc5b280
Browse files Browse the repository at this point in the history
  • Loading branch information
nilseling authored Sep 15, 2023
2 parents bc5b280 + d54aced commit d8cc3ef
Show file tree
Hide file tree
Showing 6 changed files with 141 additions and 73 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Package: imcRtools
Version: 1.7.4
Version: 1.7.5
Title: Methods for imaging mass cytometry data analysis
Description:
This R package supports the handling and analysis of imaging mass cytometry
Expand Down
8 changes: 8 additions & 0 deletions NEWS
Original file line number Diff line number Diff line change
Expand Up @@ -193,3 +193,11 @@ Changes in version 1.7.3 (2023-06-20)
Changes in version 1.7.4 (2023-08-09)

+ Bug fix: correctly setting the "aspect.ratio" argument in plotSpatial to fix the physical units of the x- and y-axis

Changes in version 1.7.5 (2023-09-14)

+ Added more internal validity checks for 'read_steinbock'
+ Changed the way messages in vroom are silenced
+ Stop allowing Object numbers to be different between intensities and regionprops
+ Stop allowing missing files in regionprops and neighbors

2 changes: 1 addition & 1 deletion R/show_cpout_features.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ show_cpout_features <- function(path,
}

cur_features <- vroom(file.path(path, eval(parse(text = display))),
col_types = cols(), progress = FALSE)
show_col_types = FALSE, progress = FALSE)

datatable(cur_features)
}
45 changes: 30 additions & 15 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,12 @@
cur_out <- bplapply(seq_along(x),
function(y){
cur_int <- vroom(x[y], progress = FALSE,
col_types = cols())
show_col_types = FALSE)

if (nrow(cur_int) == 0) {
stop("No cells detected in ", basename(x[y]))

Check warning on line 21 in R/utils.R

View check run for this annotation

Codecov / codecov/patch

R/utils.R#L21

Added line #L21 was not covered by tests
}

cur_counts <- cur_int %>% select(-all_of(cell_id))

cur_name <- sub("\\.[^.]*$", "", basename(x[y]))
Expand Down Expand Up @@ -50,16 +55,16 @@
pattern = paste0("^", cur_sample, ".csv", "$"),
full.names = TRUE)

if (length(cur_file) == 0) {
return(y)
}

cur_props <- vroom(cur_file,
progress = FALSE,
col_types = cols()) %>%
show_col_types = FALSE) %>%
as.data.frame()
rownames(cur_props) <- cur_props[[cell_id]]
cur_props <- cur_props[as.character(y$ObjectNumber),]

if (!identical(cur_props[[cell_id]], y$ObjectNumber)) {
stop("Object IDs do not match between intensities ",
"and regionprobs for file '", basename(cur_file),

Check warning on line 65 in R/utils.R

View check run for this annotation

Codecov / codecov/patch

R/utils.R#L64-L65

Added lines #L64 - L65 were not covered by tests
"'.")
}

if (return_as == "spe") {
spatialCoords(y) <- matrix(c(cur_props[[coords[1]]],
Expand Down Expand Up @@ -96,14 +101,22 @@
pattern = paste0("^", cur_sample, ".csv", "$"),
full.names = TRUE)

if (length(cur_file) == 0) {
return(y)
}

cur_graphs <- vroom(cur_file,
progress = FALSE,
col_types = cols()) %>%
show_col_types = FALSE) %>%
as.data.frame()

if (any(!cur_graphs[,1] %in% y$ObjectNumber)) {
stop("Object IDs do not match between intensities ",
"and graphs for file '", basename(cur_file),

Check warning on line 111 in R/utils.R

View check run for this annotation

Codecov / codecov/patch

R/utils.R#L110-L111

Added lines #L110 - L111 were not covered by tests
"'.")
}

if (any(!cur_graphs[,2] %in% y$ObjectNumber)) {
stop("Object IDs do not match between intensities ",
"and graphs for file '", basename(cur_file),

Check warning on line 117 in R/utils.R

View check run for this annotation

Codecov / codecov/patch

R/utils.R#L116-L117

Added lines #L116 - L117 were not covered by tests
"'.")
}

cur_hits <- SelfHits(from = match(cur_graphs[,1],
y$ObjectNumber),
Expand Down Expand Up @@ -150,11 +163,11 @@
if (file.exists(file.path(path, panel))) {
cur_panel <- vroom(file.path(path, panel),
progress = FALSE,
col_types = cols())
show_col_types = FALSE)
} else if (file.exists(panel)) {
cur_panel <- vroom(panel,
progress = FALSE,
col_types = cols())
show_col_types = FALSE)
} else {
warning("'panel_file' does not exist.")
return(x)
Expand All @@ -165,6 +178,8 @@
cur_ind <- match(rownames(x), cur_panel[,extract_names_from])

cur_panel <- cur_panel[cur_ind,]

stopifnot(identical(rownames(x), cur_panel[,extract_names_from]))

rowData(x) <- cur_panel
}
Expand Down
122 changes: 91 additions & 31 deletions R/validityChecks.R
Original file line number Diff line number Diff line change
Expand Up @@ -173,6 +173,39 @@
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.")

Check warning on line 204 in R/validityChecks.R

View check run for this annotation

Codecov / codecov/patch

R/validityChecks.R#L204

Added line #L204 was not covered by tests
}

all_int <- list.files(file.path(path, intensities_folder),
pattern = pattern, full.names = FALSE)

if (!is.null(graphs_folder)) {

Expand All @@ -183,6 +216,26 @@
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 '",
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.")

Check warning on line 237 in R/validityChecks.R

View check run for this annotation

Codecov / codecov/patch

R/validityChecks.R#L237

Added line #L237 was not covered by tests
}

}

Expand All @@ -196,30 +249,17 @@
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 '",
regionprops_folder, "' do not match.")
}

}

# 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,
col_types = cols())

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.")
}

# Check coords
if (!is.null(regionprops_folder)) {
all_files <- list.files(file.path(path, regionprops_folder),
Expand All @@ -228,15 +268,24 @@
if (length(all_files) > 0) {
cur_file <- vroom(all_files[1],
progress = FALSE,
col_types = cols())
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 warning on line 287 in R/validityChecks.R

View check run for this annotation

Codecov / codecov/patch

R/validityChecks.R#L287

Added line #L287 was not covered by tests
}
}
}

Expand All @@ -255,11 +304,22 @@
}

cur_images_file <- vroom(file.path(path, image_file), progress = FALSE,
col_types = cols())
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,
"' do not match the 'image' entry in '", image_file, "'.")

Check warning on line 321 in R/validityChecks.R

View check run for this annotation

Codecov / codecov/patch

R/validityChecks.R#L320-L321

Added lines #L320 - L321 were not covered by tests
}
}

# Check panel
Expand All @@ -271,11 +331,11 @@
if (file.exists(file.path(path, panel))) {
cur_panel <- vroom(file.path(path, panel),
progress = FALSE,
col_types = cols())
show_col_types = FALSE)
} else if (file.exists(panel)) {
cur_panel <- vroom(panel,
progress = FALSE,
col_types = cols())
show_col_types = FALSE)

Check warning on line 338 in R/validityChecks.R

View check run for this annotation

Codecov / codecov/patch

R/validityChecks.R#L338

Added line #L338 was not covered by tests
}

if (exists("cur_panel")) {
Expand Down Expand Up @@ -369,11 +429,11 @@
if (file.exists(file.path(path, panel_file))) {
cur_panel <- vroom(file.path(path, panel_file),
progress = FALSE,
col_types = cols())
show_col_types = FALSE)
} else if (file.exists(panel_file)) {
cur_panel <- vroom(panel_file,
progress = FALSE,
col_types = cols())
show_col_types = FALSE)
}

if (exists("cur_panel")) {
Expand All @@ -395,7 +455,7 @@

# Check object files
cur_file <- vroom(file.path(path, object_file), n_max = 1,
col_types = cols())
show_col_types = FALSE)

if (is.null(intensities)) {
stop("'intensities' must be specified.")
Expand Down Expand Up @@ -478,7 +538,7 @@

if (!is.null(image_file)) {
cur_file <- vroom(file.path(path, image_file), n_max = 1,
col_types = cols())
show_col_types = FALSE)

if (!is.null(extract_imagemetadata_from)) {
if (!all(extract_imagemetadata_from %in% colnames(cur_file))) {
Expand All @@ -501,7 +561,7 @@
# Check graph file
if (!is.null(graph_file)) {
cur_file <- vroom(file.path(path, graph_file), n_max = 1,
col_types = cols())
show_col_types = FALSE)

if (is.null(extract_graphimageid_from)) {
stop("'extract_graphimageid_from' must be specified.")
Expand Down
35 changes: 10 additions & 25 deletions tests/testthat/test_read_steinbock.R
Original file line number Diff line number Diff line change
Expand Up @@ -562,11 +562,12 @@ test_that("read_steinbock function works", {
expect_equal(as.numeric(cur_sce$Pos_X), cur_morph$area)
expect_equal(as.numeric(cur_sce$Pos_Y), cur_morph$major_axis_length)

cur_spe <- read_steinbock(path, extract_names_from = "channel")
# This test doesn't make sense anymore
#cur_spe <- read_steinbock(path, extract_names_from = "channel")

expect_true(all(is.na(rowData(cur_spe)["Laminin",])))
expect_equal(as.character(as.matrix(rowData(cur_spe)["Ag107",])),
c("Ag107", "Ag107", "1", "1", NA, NA))
#expect_true(all(is.na(rowData(cur_spe)["Laminin",])))
#expect_equal(as.character(as.matrix(rowData(cur_spe)["Ag107",])),
# c("Ag107", "Ag107", "1", "1", NA, NA))

cur_spe <- read_steinbock(path, image_file = NULL)

Expand Down Expand Up @@ -726,33 +727,17 @@ test_that("read_steinbock function works when files are missing", {
file.remove(list.files(paste0(cur_path, "/steinbock/regionprops"),
full.names = TRUE))

cur_spe <- read_steinbock(paste0(cur_path, "/steinbock/"))
expect_error(cur_spe <- read_steinbock(paste0(cur_path, "/steinbock/")),
"File names in 'intensities' and 'regionprops' do not match.",
fixed = TRUE)

expect_s4_class(cur_spe, "SpatialExperiment")
expect_equal(names(colData(cur_spe)), c("sample_id", "ObjectNumber",
"width_px", "height_px"))

expect_equal(colPairNames(cur_spe), "neighborhood")

# Remove graphs folder
file.remove(list.files(paste0(cur_path, "/steinbock/neighbors"),
full.names = TRUE))

cur_spe <- read_steinbock(paste0(cur_path, "/steinbock/"))

expect_s4_class(cur_spe, "SpatialExperiment")
expect_equal(names(colData(cur_spe)), c("sample_id", "ObjectNumber",
"width_px", "height_px"))

expect_error(colPair(cur_spe),
regex = "no available entries for 'colPair(<SpatialExperiment>, ...)'",
expect_error(cur_spe <- read_steinbock(paste0(cur_path, "/steinbock/")),
"File names in 'intensities' and 'neighbors' do not match.",
fixed = TRUE)

# Copy panel
file.copy(paste0(cur_path, "/steinbock/panel.csv"),
paste0(cur_path, "/steinbock/panel_2.csv"))

expect_silent(cur_spe <- read_steinbock(paste0(cur_path, "/steinbock/"),
panel_file = paste0(cur_path, "/steinbock/panel_2.csv")))

})

0 comments on commit d8cc3ef

Please sign in to comment.