Skip to contents

This vignette assumes you have already read the main example workflow. There, we chose a small metric set after looking at diagnostics, Trelliscope panels, and agreement among candidate matrices. Here we ask whether that chosen set is fragile.

precise_stability() does not touch the user’s input data. It takes a typed collection of relatedness matrices, repeatedly fuses whole-matrix subsets, and returns the replicate consensuses as another typed tibble. In other words, it asks: if we walk around the matrix set we chose, does the fused structure remain close to the full-set reference?

Setup

Recreate the same balanced subset and selected metric set used in the main workflow.

set.seed(1)

label_col <- data_cell_cycle$Cell_cycle
rows_by_label <- split(seq_len(nrow(data_cell_cycle)), label_col)
workflow_rows <- unlist(lapply(rows_by_label, head, 20), use.names = FALSE)
workflow_features <- seq_len(500)

cell_cycle <- as.matrix(data_cell_cycle[workflow_rows, -1, drop = FALSE][, workflow_features])
storage.mode(cell_cycle) <- "double"

cell_cycle_labels <- label_col[workflow_rows]
rownames(cell_cycle) <- sprintf("%s_%02d", cell_cycle_labels, seq_along(cell_cycle_labels))
cell_cycle_groups <- setNames(cell_cycle_labels, rownames(cell_cycle))

selected_metrics <- c("minkowski_0.5", "additive_symm", "lorentzian", "wavehedges")

selected_native <- precise_dist(
  cell_cycle,
  dists = selected_metrics,
  parallel = FALSE,
  verbose = FALSE
)

stability_distances <- selected_native |>
  precise_transform(
    to = "distance",
    normalize = "range01",
    diagonal = 0
  )

stability_distances[, c("distance", "metric", "type")]
#> # A tibble: 4 × 3
#>   distance      metric        type    
#>   <chr>         <chr>         <chr>   
#> 1 minkowski_0.5 minkowski_0.5 distance
#> 2 additive_symm additive_symm distance
#> 3 lorentzian    lorentzian    distance
#> 4 wavehedges    wavehedges    distance

Leave One Metric Out

First, run deterministic leave-one-metric-out stability. The first row is the reference consensus from the full set. Each remaining row drops one metric, fuses the rest, and records the dropped metric in meta.

stability_loo <- precise_stability(
  stability_distances,
  scheme = "loo",
  fusion = "mean",
  verbose = FALSE
)

stability_loo[, c("distance", "role", "fusion", "replicate")]
#> # A tibble: 5 × 4
#>   distance               role      fusion replicate
#>   <chr>                  <chr>     <chr>      <int>
#> 1 reference              reference mean           0
#> 2 loo_drop_minkowski_0.5 loo_drop  mean           1
#> 3 loo_drop_additive_symm loo_drop  mean           2
#> 4 loo_drop_lorentzian    loo_drop  mean           3
#> 5 loo_drop_wavehedges    loo_drop  mean           4

Now compare every leave-one-out consensus to the reference consensus. These values are correlations between fused distance matrices, not a scalar verdict invented by precise_stability().

stability_loo_agreement <- precise_correlations(
  stability_loo,
  permutations = 99,
  verbose = FALSE
)

loo_rows <- grep("^loo_drop_", rownames(stability_loo_agreement$statistic), value = TRUE)
round(stability_loo_agreement$statistic["reference", loo_rows], 3)
#> loo_drop_minkowski_0.5 loo_drop_additive_symm    loo_drop_lorentzian 
#>                  0.976                  0.927                  0.991 
#>    loo_drop_wavehedges 
#>                  0.987
precise_viz(
  stability_loo,
  views = "agreement",
  params = list(
    agreement = list(
      engine = workflow_plot_engine
    )
  ),
  agreement = stability_loo_agreement,
  verbose = FALSE
)$panel[[1]]

Bootstrap the Metric Set

Leave-one-out asks whether a single metric is carrying the result. Bootstrap stability asks a slightly different question: if we repeatedly resample the chosen metric set with replacement, how much does the fused consensus move?

stability_bootstrap <- precise_stability(
  stability_distances,
  scheme = "bootstrap",
  fusion = "mean",
  replicates = 10,
  seed = 42,
  verbose = FALSE
)

stability_bootstrap[, c("distance", "role", "fusion", "replicate")]
#> # A tibble: 11 × 4
#>    distance     role      fusion replicate
#>    <chr>        <chr>     <chr>      <int>
#>  1 reference    reference mean           0
#>  2 bootstrap_01 bootstrap mean           1
#>  3 bootstrap_02 bootstrap mean           2
#>  4 bootstrap_03 bootstrap mean           3
#>  5 bootstrap_04 bootstrap mean           4
#>  6 bootstrap_05 bootstrap mean           5
#>  7 bootstrap_06 bootstrap mean           6
#>  8 bootstrap_07 bootstrap mean           7
#>  9 bootstrap_08 bootstrap mean           8
#> 10 bootstrap_09 bootstrap mean           9
#> 11 bootstrap_10 bootstrap mean          10
vapply(stability_bootstrap$meta[-1], function(x) x$n_unique_inputs, integer(1))
#>  [1] 1 2 3 3 2 2 3 3 3 3
stability_bootstrap_agreement <- precise_correlations(
  stability_bootstrap,
  permutations = 99,
  verbose = FALSE
)

bootstrap_rows <- grep("^bootstrap_", rownames(stability_bootstrap_agreement$statistic), value = TRUE)
round(summary(as.numeric(stability_bootstrap_agreement$statistic["reference", bootstrap_rows])), 3)
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>   0.825   0.869   0.911   0.909   0.955   0.998
precise_viz(
  stability_bootstrap,
  views = "agreement",
  params = list(
    agreement = list(
      engine = workflow_plot_engine
    )
  ),
  agreement = stability_bootstrap_agreement,
  verbose = FALSE
)$panel[[1]]

This keeps the workflow boundary clean. precise_dist() constructs matrices from the user’s input. precise_stability() interrogates the matrix set after the user has chosen it. If the reference consensus remains close to its leave-one-out and bootstrap variants, the structure is not being carried by one lucky metric alone.