Zero-pad proximity score violin plots

CHANGELOG.md

@@ -8,8 +8,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Fixed
+
+- Missing proximity scores are now filled with 0 so every component has a value for every marker pair present in the table.
+
 ### Changed
 
+- `complete_proximity_scores()` now completes all marker pairs by default (`only_self = FALSE`) and can include components that have no scores via `component_meta`.
 - Colocalization heatmap text now explains that proteins are selected by mean abundance (up to 40 markers), globally across samples or within each cell type.
 - The Cell recovery section now explains how to read the molecule rank plot.
 - Experiment Summary labels now use "isotype control markers" consistently.

NAMESPACE

@@ -258,7 +258,9 @@ importFrom(tibble,rownames_to_column)
 importFrom(tibble,tibble)
 importFrom(tibble,tribble)
 importFrom(tidyr,complete)
+importFrom(tidyr,crossing)
 importFrom(tidyr,nesting)
+importFrom(tidyr,replace_na)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyr,separate)

R/es_data.R

@@ -653,6 +653,10 @@ test_es_data <- function(
 
 #' Extract filtered proximity scores
 #'
+#' Filtered proximity scores are completed so that every component in
+#' `pxl_data_processed` has a value for every marker pair present after
+#' filtering. Missing scores are filled with 0.
+#'
 #' @param object An `es_data` object.
 #'
 #' @return A table of filtered proximity scores.
@@ -665,6 +669,21 @@ test_es_data <- function(
     sample_levels = object$sample_aliases
   )
 
+  component_meta <-
+    FetchData(
+      object$pxl_data_processed,
+      vars = c("sample_alias", "condition", "seurat_clusters", "celltype")
+    ) %>%
+    as_tibble(rownames = "sample_component")
+
+  proximity <- complete_proximity_scores(
+    proximity,
+    only_self = FALSE,
+    component_meta = component_meta
+  )
+
+  proximity <- set_sample_levels(proximity, object$sample_aliases)
+
   return(proximity)
 }
 

R/pixelatorES-package.R

@@ -162,7 +162,9 @@
 #' @importFrom tibble tibble
 #' @importFrom tibble tribble
 #' @importFrom tidyr complete
+#' @importFrom tidyr crossing
 #' @importFrom tidyr nesting
+#' @importFrom tidyr replace_na
 #' @importFrom tidyr pivot_longer
 #' @importFrom tidyr pivot_wider
 #' @importFrom tidyr separate

R/processing.R

@@ -138,11 +138,17 @@ filter_proximity_scores <- function(
 
 #' Complete Proximity Scores
 #'
-#' This function completes the proximity scores by ensuring that each marker pair has a score for each sample component,
-#' filling missing values with 0.
+#' Ensure every component has a proximity score for every marker pair present in
+#' `proximity_scores`. Missing component–pair combinations are filled with 0
+#' for `log2_ratio` and `join_count_z`.
 #'
 #' @param proximity_scores A data frame of proximity scores.
-#' @param only_self A boolean indicating whether to filter for self-comparisons only (default is TRUE).
+#' @param only_self A boolean indicating whether to keep only self-comparisons
+#'   (`marker_1 == marker_2`) before completing (default is `FALSE`).
+#' @param component_meta Optional tibble of all components to include, with
+#'   columns `sample_component`, `sample_alias`, `condition`, `seurat_clusters`,
+#'   and `celltype`. When `NULL`, only components already present in
+#'   `proximity_scores` are completed.
 #'
 #' @return A data frame of completed proximity scores with missing values filled.
 #'
@@ -151,23 +157,92 @@ filter_proximity_scores <- function(
 complete_proximity_scores <-
   function(
     proximity_scores,
-    only_self = TRUE
+    only_self = FALSE,
+    component_meta = NULL
   ) {
     pixelatorR:::assert_class(proximity_scores, "tbl_df")
     pixelatorR:::assert_single_value(only_self, "bool")
+    pixelatorR:::assert_class(component_meta, "tbl_df", allow_null = TRUE)
+
+    proximity_scores <- ungroup(proximity_scores)
 
     if (only_self) {
       proximity_scores <-
         proximity_scores %>%
         filter(marker_1 == marker_2)
     }
 
-    proximity_scores %>%
-      complete(
-        nesting(sample_component, sample_alias, condition, seurat_clusters, celltype),
-        nesting(marker_1, marker_2),
-        fill = list(log2_ratio = 0)
+    fill_vals <- list()
+    if ("log2_ratio" %in% names(proximity_scores)) {
+      fill_vals$log2_ratio <- 0
+    }
+    if ("join_count_z" %in% names(proximity_scores)) {
+      fill_vals$join_count_z <- 0
+    }
+
+    key_cols <- c(
+      "sample_component", "sample_alias", "condition",
+      "seurat_clusters", "celltype"
+    )
+
+    if (is.null(component_meta)) {
+      completed <-
+        proximity_scores %>%
+        complete(
+          nesting(
+            sample_component, sample_alias, condition,
+            seurat_clusters, celltype
+          ),
+          nesting(marker_1, marker_2),
+          fill = fill_vals
+        )
+
+      return(completed)
+    }
+
+    missing_cols <- setdiff(key_cols, names(component_meta))
+    if (length(missing_cols) > 0) {
+      cli_abort(c(
+        "{.arg component_meta} is missing required columns.",
+        "x" = "Missing: {.val {missing_cols}}."
+      ))
+    }
+
+    marker_pairs <-
+      proximity_scores %>%
+      distinct(marker_1, marker_2) %>%
+      filter(!is.na(marker_1), !is.na(marker_2))
+
+    if (nrow(marker_pairs) == 0) {
+      return(proximity_scores)
+    }
+
+    score_cols <- setdiff(
+      names(proximity_scores),
+      c(key_cols, "marker_1", "marker_2")
+    )
+
+    proximity_values <-
+      proximity_scores %>%
+      select(sample_component, marker_1, marker_2, all_of(score_cols))
+
+    completed <-
+      crossing(
+        component_meta %>%
+          select(all_of(key_cols)) %>%
+          distinct(),
+        marker_pairs
+      ) %>%
+      left_join(
+        proximity_values,
+        by = c("sample_component", "marker_1", "marker_2")
       )
+
+    if (length(fill_vals) > 0) {
+      completed <- replace_na(completed, fill_vals)
+    }
+
+    return(completed)
   }
 
 #' Summarize proximity scores per sample and condition

tests/testthat/test_es_data.R

@@ -941,6 +941,18 @@ test_that("es_data parity with legacy preprocessing works as expected", {
       params,
       sample_levels = sample_aliases
     )
+    component_meta <-
+      FetchData(
+        pg_data_processed,
+        vars = c("sample_alias", "condition", "seurat_clusters", "celltype")
+      ) %>%
+      as_tibble(rownames = "sample_component")
+    proximity_scores <- complete_proximity_scores(
+      proximity_scores,
+      only_self = FALSE,
+      component_meta = component_meta
+    )
+    proximity_scores <- set_sample_levels(proximity_scores, sample_aliases)
 
     return(list(
       samplesheet = sample_sheet,

tests/testthat/test_processing.R

@@ -389,3 +389,125 @@ test_that("Proximity ANOVAs work as expected", {
     ))
   )
 })
+
+test_that("Proximity scores are zero-padded as expected", {
+  proximity_scores <- tibble(
+    sample_component = c("c1", "c1", "c2"),
+    sample_alias = factor(c("S1", "S1", "S1"), levels = c("S1", "S2")),
+    condition = "unstim",
+    seurat_clusters = "1",
+    celltype = "T",
+    marker_1 = factor(c("CD3", "CD3", "CD4"), levels = c("CD3", "CD4")),
+    marker_2 = factor(c("CD3", "CD4", "CD4"), levels = c("CD3", "CD4")),
+    log2_ratio = c(0.5, 0.2, 0.1),
+    join_count_z = c(1.2, 0.3, 0.8)
+  )
+
+  completed <- complete_proximity_scores(proximity_scores, only_self = FALSE) %>%
+    arrange(sample_component, marker_1, marker_2)
+
+  expect_equal(
+    completed,
+    structure(list(
+      sample_component = c("c1", "c1", "c1", "c2", "c2", "c2"),
+      sample_alias = structure(
+        c(1L, 1L, 1L, 1L, 1L, 1L),
+        levels = c("S1", "S2"),
+        class = "factor"
+      ),
+      condition = c("unstim", "unstim", "unstim", "unstim", "unstim", "unstim"),
+      seurat_clusters = c("1", "1", "1", "1", "1", "1"),
+      celltype = c("T", "T", "T", "T", "T", "T"),
+      marker_1 = structure(
+        c(1L, 1L, 2L, 1L, 1L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      marker_2 = structure(
+        c(1L, 2L, 2L, 1L, 2L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      log2_ratio = c(0.5, 0.2, 0, 0, 0, 0.1),
+      join_count_z = c(1.2, 0.3, 0, 0, 0, 0.8)
+    ), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))
+  )
+
+  completed_self <- complete_proximity_scores(proximity_scores, only_self = TRUE) %>%
+    arrange(sample_component, marker_1, marker_2)
+
+  expect_equal(
+    completed_self,
+    structure(list(
+      sample_component = c("c1", "c1", "c2", "c2"),
+      sample_alias = structure(
+        c(1L, 1L, 1L, 1L),
+        levels = c("S1", "S2"),
+        class = "factor"
+      ),
+      condition = c("unstim", "unstim", "unstim", "unstim"),
+      seurat_clusters = c("1", "1", "1", "1"),
+      celltype = c("T", "T", "T", "T"),
+      marker_1 = structure(
+        c(1L, 2L, 1L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      marker_2 = structure(
+        c(1L, 2L, 1L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      log2_ratio = c(0.5, 0, 0, 0.1),
+      join_count_z = c(1.2, 0, 0, 0.8)
+    ), row.names = c(NA, -4L), class = c("tbl_df", "tbl", "data.frame"))
+  )
+
+  component_meta <- tibble(
+    sample_component = c("c1", "c2", "c3"),
+    sample_alias = factor(c("S1", "S1", "S2"), levels = c("S1", "S2")),
+    condition = c("unstim", "unstim", "stim"),
+    seurat_clusters = c("1", "1", "2"),
+    celltype = c("T", "T", "B")
+  )
+
+  completed_all <- complete_proximity_scores(
+    proximity_scores,
+    only_self = FALSE,
+    component_meta = component_meta
+  ) %>%
+    arrange(sample_component, marker_1, marker_2)
+
+  expect_equal(
+    completed_all,
+    structure(list(
+      sample_component = c(
+        "c1", "c1", "c1", "c2", "c2", "c2", "c3", "c3", "c3"
+      ),
+      sample_alias = structure(
+        c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L),
+        levels = c("S1", "S2"),
+        class = "factor"
+      ),
+      condition = c(
+        "unstim", "unstim", "unstim",
+        "unstim", "unstim", "unstim",
+        "stim", "stim", "stim"
+      ),
+      seurat_clusters = c("1", "1", "1", "1", "1", "1", "2", "2", "2"),
+      celltype = c("T", "T", "T", "T", "T", "T", "B", "B", "B"),
+      marker_1 = structure(
+        c(1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      marker_2 = structure(
+        c(1L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 2L),
+        levels = c("CD3", "CD4"),
+        class = "factor"
+      ),
+      log2_ratio = c(0.5, 0.2, 0, 0, 0, 0.1, 0, 0, 0),
+      join_count_z = c(1.2, 0.3, 0, 0, 0, 0.8, 0, 0, 0)
+    ), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
+  )
+})