Add sccomp_test_smooth function for hypothesis testing along smooth t…

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: sccomp
 Type: Package
 Title: Differential Composition and Variability Analysis for Single-Cell Data
-Version: 2.1.34
-Date: 2026-05-11
+Version: 2.5.1
+Date: 2026-08-07
 Authors@R: c(person("Stefano", "Mangiola", email = "stefano.mangiola@unimelb.edu.au", role = c("aut", "cre")), person("Alexandra J.", "Roth-Schulze", role = "aut"), person("Marie", "Trussart", role = "aut"), person("Enrique", "Zozaya-Valdés", role = "aut"), person("Mengyao", "Ma", role = "aut"), person("Zijie", "Gao", role = "aut"), person("Alan F.", "Rubin", role = "aut"), person("Terence P.", "Speed", role = "aut"), person("Heejung", "Shim", role = "aut"), person("Anthony T.", "Papenfuss", role = "aut"))
 Description: Comprehensive R package for differential composition and variability analysis in single-cell RNA sequencing, CyTOF, and microbiome data. Provides robust Bayesian modeling with outlier detection, random effects, and advanced statistical methods for cell type proportion analysis. Features include probabilistic outlier identification, mixed-effect modeling, differential variability testing, and comprehensive visualization tools. Perfect for cancer research, immunology, developmental biology, and single-cell genomics applications.
 License: GPL-3

NAMESPACE

@@ -13,6 +13,7 @@ S3method(sccomp_remove_outliers,sccomp_tbl)
 S3method(sccomp_remove_unwanted_effects,sccomp_tbl)
 S3method(sccomp_replicate,sccomp_tbl)
 S3method(sccomp_test,sccomp_tbl)
+S3method(sccomp_test_smooth,sccomp_tbl)
 S3method(simulate_data,tbl)
 export(clear_draw_files)
 export(clear_stan_model_cache)
@@ -32,6 +33,7 @@ export(sccomp_replicate)
 export(sccomp_scatterplot)
 export(sccomp_stan_models_cache_dir)
 export(sccomp_test)
+export(sccomp_test_smooth)
 export(sccomp_theme)
 export(simulate_data)
 import(dplyr)
@@ -68,6 +70,8 @@ importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
 importFrom(dplyr,slice)
 importFrom(dplyr,summarise)
+importFrom(dplyr,tibble)
+importFrom(dplyr,ungroup)
 importFrom(dplyr,where)
 importFrom(dplyr,with_groups)
 importFrom(forcats,fct_inorder)
@@ -148,11 +152,13 @@ importFrom(rlang,quo_is_symbolic)
 importFrom(rlang,quo_name)
 importFrom(rlang,quo_squash)
 importFrom(rlang,set_names)
+importFrom(rlang,sym)
 importFrom(scales,trans_new)
 importFrom(stats,C)
 importFrom(stats,as.formula)
 importFrom(stats,model.matrix)
 importFrom(stats,quantile)
+importFrom(stats,sd)
 importFrom(stats,terms)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_remove)

R/model_fitting.R

@@ -69,12 +69,12 @@ fit_model = function(
     init_list$prec_slope_2 = rep(0, data_for_model$A)
   }
 
-  # Random effect inits - 4 uniform slots (one per non-empty random-effect block).
+  # Random effect inits - 5 uniform slots (one per non-empty random-effect block).
   # Each slot gets zero-initialised raws + an identity-like correlation Cholesky.
   if (data_for_model$n_random_eff > 0) {
     init_list$zero_random_effect = rep(0, size = 1) |> as.array()
 
-    for (k in seq_len(4L)) {
+    for (k in seq_len(5L)) {
       if (data_for_model$ncol_X_random_eff[k] == 0) next
       K = data_for_model$how_many_factors_in_random_design[k]
 

R/sccomp_estimate.R

@@ -1085,8 +1085,8 @@ sccomp_glm_data_frame_counts = function(.data,
         "beta", "alpha",
         "prec_intercept_1", "prec_slope_1", "prec_intercept_2", "prec_slope_2",
         "prec_sd",
-        # Random effect outputs - one per slot (1..4)
-        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4",
+        # Random effect outputs - one per slot (1..5)
+        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4", "random_effect_5",
         "log_lik"
       ),
       sig_figs = sig_figs,

R/sccomp_remove_outliers.R

@@ -212,21 +212,21 @@ sccomp_remove_outliers.sccomp_tbl = function(.estimate,
           # the slot's columns; unseen matrices are empty).
           ncol_X_random_eff_new        = data_for_model$ncol_X_random_eff,
           length_X_random_effect_which = data_for_model$ncol_X_random_eff,
-          ncol_X_random_eff_unseen     = rep(0L, 4L),
+          ncol_X_random_eff_unseen     = rep(0L, 5L),
 
           create_intercept = FALSE
         ),
         # Identity which-indices per slot, generated programmatically
         setNames(
-          lapply(seq_len(4L), function(k)
+          lapply(seq_len(5L), function(k)
             seq_len(data_for_model$ncol_X_random_eff[k]) |> as.array()),
-          paste0("X_random_effect_which_", seq_len(4L))
+          paste0("X_random_effect_which_", seq_len(5L))
         ),
         # Empty unseen design matrices per slot
         setNames(
-          replicate(4L, matrix(0, nrow = nrow(data_for_model$X), ncol = 0),
+          replicate(5L, matrix(0, nrow = nrow(data_for_model$X), ncol = 0),
                     simplify = FALSE),
-          paste0("X_random_effect_", seq_len(4L), "_unseen")
+          paste0("X_random_effect_", seq_len(5L), "_unseen")
         )
       ),
 
@@ -339,7 +339,7 @@ sccomp_remove_outliers.sccomp_tbl = function(.estimate,
       pars = c(
         "beta", "alpha",
         "prec_intercept_1", "prec_slope_1", "prec_intercept_2", "prec_slope_2", "prec_sd",
-        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4"
+        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4", "random_effect_5"
       ),
       sig_figs = sig_figs,
       cache_stan_model = cache_stan_model,
@@ -365,19 +365,19 @@ sccomp_remove_outliers.sccomp_tbl = function(.estimate,
         # Per-slot random-effect pass-throughs (see notes in the first call site)
         ncol_X_random_eff_new        = data_for_model$ncol_X_random_eff,
         length_X_random_effect_which = data_for_model$ncol_X_random_eff,
-        ncol_X_random_eff_unseen     = rep(0L, 4L),
+        ncol_X_random_eff_unseen     = rep(0L, 5L),
 
         create_intercept = FALSE
       ),
       setNames(
-        lapply(seq_len(4L), function(k)
+        lapply(seq_len(5L), function(k)
           seq_len(data_for_model$ncol_X_random_eff[k]) |> as.array()),
-        paste0("X_random_effect_which_", seq_len(4L))
+        paste0("X_random_effect_which_", seq_len(5L))
       ),
       setNames(
-        replicate(4L, matrix(0, nrow = nrow(data_for_model$X), ncol = 0),
+        replicate(5L, matrix(0, nrow = nrow(data_for_model$X), ncol = 0),
                   simplify = FALSE),
-        paste0("X_random_effect_", seq_len(4L), "_unseen")
+        paste0("X_random_effect_", seq_len(5L), "_unseen")
       )
     ),
 
@@ -476,7 +476,7 @@ sccomp_remove_outliers.sccomp_tbl = function(.estimate,
       pars = c(
         "beta", "alpha",
         "prec_intercept_1", "prec_slope_1", "prec_intercept_2", "prec_slope_2", "prec_sd",
-        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4", "log_lik"
+        "random_effect_1", "random_effect_2", "random_effect_3", "random_effect_4", "random_effect_5", "log_lik"
       ),
       cache_stan_model = cache_stan_model,
       ...

R/sccomp_replicate.R

@@ -126,7 +126,7 @@ sccomp_replicate.sccomp_tbl = function(fit,
 #' @param Xa Original variability design matrix
 #' @param N Original number of samples
 #' @param intercept_in_design Whether intercept is in design
-#' @param X_random_effect_slots Length-4 list of original random-effect design
+#' @param X_random_effect_slots Length-5 list of original random-effect design
 #'   matrices (one per slot). Empty slots are zero-column matrices.
 #' @param .sample Quosure for the sample identifier column
 #' @param .cell_group Quosure for the cell group column
@@ -150,7 +150,7 @@ sccomp_replicate.sccomp_tbl = function(fit,
 #' - model_input: The prepared model input data
 #' - X_which: Indices for the composition design matrix
 #' - XA_which: Indices for the variability design matrix
-#' - X_random_effect_which_1..4: per-slot indices into the original RE design matrix
+#' - X_random_effect_which_1..5: per-slot indices into the original RE design matrix
 #' - create_intercept: Boolean indicating if intercept should be created
 #' 
 #' @noRd
@@ -251,7 +251,12 @@ prepare_replicate_data = function(X,
         paste(collapse="") |>
         as.formula(),
       !!.sample, 
-      accept_NA_as_average_effect = TRUE
+      accept_NA_as_average_effect = TRUE,
+      # Continuous covariates are z-scored here. The centre and the scale have
+      # to come from the fitted samples alone: taking them from `new_data`,
+      # which carries the old rows too, would make the prediction at a given
+      # covariate value depend on the range and density of the requested grid.
+      scaling_reference = old_data
     ) |>
     tail(nrow_new_data) %>%
     # Remove columns that are not in the original design matrix
@@ -294,7 +299,8 @@ prepare_replicate_data = function(X,
         paste(collapse="") |>
         as.formula(),
       !!.sample, 
-      accept_NA_as_average_effect = TRUE
+      accept_NA_as_average_effect = TRUE,
+      scaling_reference = old_data
     ) |>
     tail(nrow_new_data) %>%
     # Remove columns that are not in the original design matrix
@@ -328,13 +334,14 @@ prepare_replicate_data = function(X,
     mutate(design = map2(
       formula, grouping,
       ~ get_random_effect_design3(new_data, .x, .y, !!.sample,
-                                  accept_NA_as_average_effect = TRUE)
+                                  accept_NA_as_average_effect = TRUE,
+                                  scaling_reference = old_data)
     ))
 
   # ----------------------------------------------------------------------
   # Build the per-slot replicate design matrices.
   #
-  # For each of the 4 slots: if the slot was active in the original fit
+  # For each of the 5 slots: if the slot was active in the original fit
   # (original_grouping_names[k] exists) and the new formula references it,
   # build a new design matrix restricted to the columns the model saw, and
   # an index vector mapping new columns back to those of the original matrix.
@@ -387,7 +394,7 @@ prepare_replicate_data = function(X,
     list(X = X_new, X_unseen = X_new_unseen, which = which_idx)
   }
 
-  replicate_slots = map(seq_len(4L), build_replicate_slot)
+  replicate_slots = map(seq_len(5L), build_replicate_slot)
 
   # Append smooth-derived replicate slots (one per smooth term in the
   # composition formula). They occupy whichever slots come after the
@@ -396,9 +403,9 @@ prepare_replicate_data = function(X,
     n_explicit_re = length(original_grouping_names)
     n_smooth      = length(smooth_replicate_slots)
     n_used        = n_explicit_re + n_smooth
-    if (n_used > 4L) {
+    if (n_used > 5L) {
       stop(sprintf(
-        "sccomp says: the replicate model needs %d RE slot(s) but only 4 are available.",
+        "sccomp says: the replicate model needs %d RE slot(s) but only 5 are available.",
         n_used
       ))
     }
@@ -409,7 +416,7 @@ prepare_replicate_data = function(X,
   }
 
   # setup default unknown_grouping variable for generated quantities
-  unknown_grouping = rep(0L, 4L)
+  unknown_grouping = rep(0L, 5L)
 
   list(
     X        = new_X,
@@ -422,16 +429,19 @@ prepare_replicate_data = function(X,
     X_random_effect_2 = replicate_slots[[2]]$X,
     X_random_effect_3 = replicate_slots[[3]]$X,
     X_random_effect_4 = replicate_slots[[4]]$X,
+    X_random_effect_5 = replicate_slots[[5]]$X,
 
     X_random_effect_1_unseen = replicate_slots[[1]]$X_unseen,
     X_random_effect_2_unseen = replicate_slots[[2]]$X_unseen,
     X_random_effect_3_unseen = replicate_slots[[3]]$X_unseen,
     X_random_effect_4_unseen = replicate_slots[[4]]$X_unseen,
+    X_random_effect_5_unseen = replicate_slots[[5]]$X_unseen,
 
     X_random_effect_which_1 = replicate_slots[[1]]$which,
     X_random_effect_which_2 = replicate_slots[[2]]$which,
     X_random_effect_which_3 = replicate_slots[[3]]$which,
     X_random_effect_which_4 = replicate_slots[[4]]$which,
+    X_random_effect_which_5 = replicate_slots[[5]]$which,
 
     ncol_X_random_eff_new    = map_int(replicate_slots, ~ ncol(.x$X)),
     ncol_X_random_eff_unseen = map_int(replicate_slots, ~ ncol(.x$X_unseen)),
@@ -497,7 +507,7 @@ replicate_data = function(.data,
     Xa = model_input$Xa,
     N = model_input$N,
     intercept_in_design = model_input$intercept_in_design,
-    X_random_effect_slots = lapply(seq_len(4L), function(k)
+    X_random_effect_slots = lapply(seq_len(5L), function(k)
       model_input[[paste0("X_random_effect_", k)]]),
     .sample = !!.sample,
     .cell_group = !!.cell_group,
@@ -523,8 +533,8 @@ replicate_data = function(.data,
   model_input$N        = prepared_data$N
   model_input$exposure = prepared_data$exposure
 
-  # Per-slot RE design + unseen + which-indices (4 slots)
-  for (k in seq_len(4L)) {
+  # Per-slot RE design + unseen + which-indices (5 slots)
+  for (k in seq_len(5L)) {
     model_input[[paste0("X_random_effect_", k)]]            = prepared_data[[paste0("X_random_effect_", k)]]
     model_input[[paste0("X_random_effect_", k, "_unseen")]] = prepared_data[[paste0("X_random_effect_", k, "_unseen")]]
     model_input[[paste0("X_random_effect_which_", k)]]      = prepared_data[[paste0("X_random_effect_which_", k)]]
@@ -539,9 +549,9 @@ replicate_data = function(.data,
   model_input$X_which         = prepared_data$X_which
   model_input$XA_which        = prepared_data$XA_which
 
-  # Length-4 vector of which-index lengths for the random-effect slots
+  # Length-5 vector of which-index lengths for the random-effect slots
   model_input$length_X_random_effect_which =
-    map_int(seq_len(4L), ~ length(prepared_data[[paste0("X_random_effect_which_", .x)]]))
+    map_int(seq_len(5L), ~ length(prepared_data[[paste0("X_random_effect_which_", .x)]]))
 
   # Should I create an intercept for generate quantities?
   model_input$create_intercept = prepared_data$create_intercept

R/sccomp_test.R

@@ -352,8 +352,8 @@ sccomp_summarise_posterior_for_estimate <- function(
       prefix = "c_"
     )
   )
-  # Random effect blocks: append a summary for each non-empty slot (1..4).
-  for (k in seq_len(4L)) {
+  # Random effect blocks: append a summary for each non-empty slot (1..5).
+  for (k in seq_len(5L)) {
     if (model_input$ncol_X_random_eff[k] == 0) next
     X_slot <- model_input[[paste0("X_random_effect_", k)]]
     abundance_parts <- c(
@@ -495,7 +495,7 @@ build_stan_parameter_subset <- function(contrasts, design_columns, stan_paramete
 }
 
 # ----------------------------------------------------------------------
-# Random effect draws: extract one slot at a time (1..4) and left-join into
+# Random effect draws: extract one slot at a time (1..5) and left-join into
 # `draws`. Per-slot logic is identical, so we loop over a helper instead of
 # duplicating the block once per slot.
 # ----------------------------------------------------------------------
@@ -611,7 +611,7 @@ get_abundance_contrast_draws = function(.data, contrasts = NULL){
 
   random_effect_covariates_all = character(0)
 
-  for (k in seq_len(4L)) {
+  for (k in seq_len(5L)) {
     if (model_input$ncol_X_random_eff[k] == 0) next
     res <- add_random_effect_draws(draws, contrasts, model_input, k, attr(.data, "fit"))
     draws <- res$draws