Add function to RecoverUnassignedCells

NAMESPACE

@@ -25,6 +25,7 @@ export(PlotUcellCorrelation)
 export(PredictCellTypeProbability)
 export(PredictTcellActivation)
 export(PredictTcellActivationUsingCustomModel)
+export(RecoverUnassignedCells)
 export(RegisterGeneSet)
 export(RunCellTypist)
 export(RunScGate)

R/CellTypist.R

@@ -1,7 +1,7 @@
 #' @include Utils.R
 
 utils::globalVariables(
-  names = c('majority_voting', 'Fraction', 'PropPerCluster', 'over_clustering', 'predicted_labels', 'totalPerCluster', 'totalPerLabel', 'propPerLabel', 'sortOrder', 'Category', 'reason', 'cellbarcode'),
+  names = c('majority_voting', 'Fraction', 'PropPerCluster', 'over_clustering', 'predicted_labels', 'totalPerCluster', 'totalPerLabel', 'propPerLabel', 'sortOrder', 'Category', 'reason', 'cellbarcode', 'Prop', 'TotalCells', 'TotalCellsForGroup'),
   package = 'RIRA',
   add = TRUE
 )
@@ -669,5 +669,83 @@ FilterDisallowedClasses <- function(seuratObj, sourceField = 'RIRA_Immune_v2.maj
 
   print(table(seuratObj@meta.data[[sourceField]], seuratObj@meta.data[[outputFieldName]]))
 
+  return(seuratObj)
+}
+
+#' @title RecoverUnassignedCells
+#'
+#' @description This step recovers unassigned cells by inspecting each cluster and assigning Unassigned cells to the match the cluster majority
+#' @param seuratObj The seurat object
+#' @param classField The name of the field holding the cell type call
+#' @param groupField The field on which to group, such as the cluster ID
+#' @param targetField The field that will store the result
+#' @param unassignedValues A list of string values that denote Unassigned/Unknown cells
+#' @param minClusterProp If at least this proportion of the group is one class, unassigned cells will be assigned as this class
+#' @return The updated seurat object
+#' @export
+RecoverUnassignedCells <- function(seuratObj, classField = 'RIRA_Immune_v2.cellclass', groupField = 'ClusterNames_0.2', targetField = 'RIRA_Immune_v2.cellclass.recovered', unassignedValues = c('Unassigned', 'Unknown'), minClusterProp = 0.6) {
+  if (!classField %in% names(seuratObj@meta.data)) {
+    stop(paste0('Missing field: ', classField))
+  }
+
+  seuratObj[[targetField]] <- seuratObj[[classField]]
+
+  x <- seuratObj@meta.data %>%
+    dplyr::group_by(dplyr::across(dplyr::all_of(groupField))) %>%
+    dplyr::mutate(TotalCellsForGroup = dplyr::n()) %>%
+    dplyr::group_by(dplyr::across(dplyr::all_of(c(groupField, classField, 'TotalCellsForGroup')))) %>%
+    dplyr::summarize(TotalCells = dplyr::n()) %>%
+    as.data.frame() %>%
+    dplyr::mutate(Prop = TotalCells / TotalCellsForGroup)
+
+  print('Before:')
+  print(table(seuratObj@meta.data[[classField]], seuratObj@meta.data[[targetField]]))
+
+  for (clusterName in unique(x[[groupField]])) {
+    if (is.na(clusterName)) {
+      next
+    }
+    print(paste0('Inspecting: ', clusterName))
+
+    y <- x %>%
+      dplyr::filter(!!rlang::sym(groupField) == clusterName) %>%
+      dplyr::filter(!(!!rlang::sym(classField) %in% unassignedValues)) %>%
+      dplyr::filter(Prop >= minClusterProp) %>%
+      dplyr::arrange(-Prop)
+
+    if (nrow(y) == 0) {
+      next
+    }
+
+    toUpdate <- x %>%
+      dplyr::filter(!!rlang::sym(groupField) == clusterName) %>%
+      dplyr::filter(!(!!rlang::sym(classField) %in% unassignedValues))
+
+    if (nrow(toUpdate) == 0) {
+      next
+    }
+
+    maxValue <- as.character(y[[classField]][1])
+    sel <- (!is.na(seuratObj@meta.data[[groupField]]) & seuratObj@meta.data[[groupField]] == clusterName) & (!is.na(seuratObj@meta.data[[classField]]) & seuratObj@meta.data[[classField]] %in% unassignedValues)
+    if (any(is.na(sel))) {
+      stop('NA values in the cell selector')
+    }
+
+    print(paste0('Reassigning ', sum(sel), ' cells from [', paste0(unassignedValues, collapse = ','), '] to ', maxValue))
+
+    seuratObj@meta.data[[targetField]][sel] <- maxValue
+  }
+
+  print('After:')
+  print(table(seuratObj@meta.data[[classField]], seuratObj@meta.data[[targetField]]))
+
+  # One more simple field:
+  seuratObj@meta.data[['RIRA_Immune_v2.cellclass.threeclass']] <- dplyr::case_when(
+    is.na(seuratObj@meta.data[[targetField]]) ~ 'NotTorB',
+    seuratObj@meta.data[[targetField]] == 'T_NK' ~ 'T_NK',
+    seuratObj@meta.data[[targetField]] == 'Bcell' ~ 'Bcell',
+    .default = 'NotTorB'
+  )
+
   return(seuratObj)
 }

R/Classification.R

@@ -647,12 +647,7 @@ PredictTcellActivationUsingCustomModel <- function(seuratObj, modelName, modelFi
 
   modelObj <- readRDS(modelFile)
   if (!.CanPredict(modelObj)) {
-    #user provides some other kind of model object, but it can't predict using stats::predict
-    if (length(modelList) == 1) { 
-      stop(paste0("Provided model does not have a detectable predict method. Please provide a valid model or file path to an RDS file containing a trained model."))
-    } else {
-      stop(paste0("Model '", modelName, "' does not have a detectable predict method. Please provide valid models or file paths to RDS files containing trained models."))
-    }
+    stop(paste0("Model '", modelName, "' does not have a detectable predict method. Please provide valid models or file paths to RDS files containing trained models."))
   }
 
   # Deetermine expected number of components from model coefficients

tests/testthat/test-celltypist.R

@@ -148,4 +148,19 @@ test_that("FilterDisallowedClasses works as expected", {
   expect_equal(21, sum(seuratObj$DisallowedUCellCombinations == 'Erythrocyte.RM_UCell', na.rm = T), tolerance = 1)
   expect_equal(55, sum(seuratObj$DisallowedUCellCombinations == 'NK.RM_UCell', na.rm = T), tolerance = 3)
   expect_equal(57, sum(seuratObj$DisallowedUCellCombinations == 'Platelet.RM_UCell', na.rm = T), tolerance = 1)
+
+  # Create fake clustering:
+  print(table(seuratObj$RIRA_Immune_v2.cellclass, seuratObj$scGateConsensus))
+  seuratObj <- RecoverUnassignedCells(seuratObj, groupField = 'scGateConsensus')
+  print(table(seuratObj$RIRA_Immune_v2.cellclass.recovered))
+
+  # These should be unchanged from above:
+  expect_equal(258, sum(seuratObj$RIRA_Immune_v2.cellclass == 'Bcell', na.rm = T))
+  expect_equal(577, sum(seuratObj$RIRA_Immune_v2.cellclass == 'Myeloid', na.rm = T))
+  expect_equal(1340, sum(seuratObj$RIRA_Immune_v2.cellclass == 'T_NK', na.rm = T))
+
+  expect_equal(336, sum(seuratObj$RIRA_Immune_v2.cellclass.recovered == 'Bcell', na.rm = T))
+  expect_equal(665, sum(seuratObj$RIRA_Immune_v2.cellclass.recovered == 'Myeloid', na.rm = T))
+  expect_equal(1615, sum(seuratObj$RIRA_Immune_v2.cellclass.recovered == 'T_NK', na.rm = T))
+
 })