diff --git a/R/memberships.R b/R/memberships.R index 0d38d7c..0c6f02c 100644 --- a/R/memberships.R +++ b/R/memberships.R @@ -38,6 +38,18 @@ paste(labels, collapse = if (identical(gate_logic, "or")) " or " else " and ") } +# What the bitsets are positional against: the column names in order, and the sample partition +# they were packed per sample with. A column count alone let an object with the same number of +# events in a different order, or partitioned into different samples, read the wrong events as +# members; the stored digests make the read refuse it, as the documentation always promised. +.gatelabr_membership_fingerprint <- function(sce, partition) { + list( + sample_column = partition$column, + columns = digest::digest(colnames(sce), algo = "xxhash64"), + partition = digest::digest(partition$event_indices, algo = "xxhash64") + ) +} + # Validate the payload an explicit save carries and pack it against this SCE's sample layout. .gatelabr_pack_host_memberships <- function( sce, @@ -156,6 +168,7 @@ revision = as.integer(revision), saved_at = saved_at, event_count = ncol(sce), + fingerprint = .gatelabr_membership_fingerprint(sce, partition), hierarchies = hierarchies, populations = populations, masks = masks @@ -198,6 +211,29 @@ call. = FALSE ) } + # Records written before the fingerprint existed carry none and keep the column-count check + # alone; a record that has one must match the object's event order and sample partition. + saved <- record$fingerprint + if (is.list(saved)) { + now <- tryCatch( + .gatelabr_membership_fingerprint( + sce, + .gatelabr_sample_partition(sce, saved$sample_column, include_metadata = FALSE) + ), + error = function(e) NULL + ) + if (is.null(now) || !identical(now$columns, saved$columns) || + !identical(now$partition, saved$partition)) { + stop( + "The stored population memberships were saved on an object whose events were in a ", + "different order or belonged to different samples: this SCE has the same number of ", + "columns, but its column names or its sample partition are not those the memberships ", + "were packed against (subsetting or reordering an SCE does not carry them). ", + "Press \"Save to SCE\" in GateLabR on this object.", + call. = FALSE + ) + } + } current <- .gatelabr_canonical_workspace_record(sce) current_revision <- if (is.null(current)) 0L else current$revision if (!identical(as.integer(record$revision), current_revision) && !isTRUE(allow_stale)) { diff --git a/tests/testthat/test-memberships.R b/tests/testthat/test-memberships.R index 110454f..18c74d2 100644 --- a/tests/testthat/test-memberships.R +++ b/tests/testthat/test-memberships.R @@ -219,6 +219,23 @@ test_that("memberships are refused on an object they were not saved on", { expect_error(gatelabPopulations(make_memberships_sce()), "No population memberships") sce <- store_with_memberships()$sce expect_error(gatelabPopulations(sce[, 1:2]), "cover 3 events but this SCE has 2 columns") + # Same column count, different order: the bitsets are positional, so this read the wrong + # events as members while the documentation said it would be refused. Now it is. + expect_error(gatelabPopulations(sce[, c(2, 1, 3)]), "different order") + # Same order, a different sample partition: masks packed per sample no longer line up. + moved <- sce + SummarizedExperiment::colData(moved)$sample_id[3] <- "Donor A" + expect_error(gatelabPopulations(moved), "different order") + # The object they were saved on still reads. + expect_identical(dim(gatelabPopulations(sce)), c(3L, 3L)) +}) + +test_that("a record saved before the fingerprint existed still reads on its own object", { + sce <- store_with_memberships()$sce + workspace <- S4Vectors::metadata(sce)$gatelab_workspace + workspace$memberships$fingerprint <- NULL + S4Vectors::metadata(sce)$gatelab_workspace <- workspace + expect_identical(dim(gatelabPopulations(sce)), c(3L, 3L)) }) test_that("a malformed memberships payload is refused before anything is stored", {