New fun compare cel pop

.Rbuildignore

@@ -5,3 +5,5 @@
 ^Dockerfile$
 ^Dockerfiles/.*$
 ^Conda_Recipe/.*$
+^doc$
+^Meta$

.gitignore

@@ -12,6 +12,7 @@ tests/testthat/output/
 
 inst/doc
 #inst/extdata/*
-docs
 *.Rds
 *.rds
+/doc/
+/Meta/

CHANGELOG.md

@@ -1,6 +1,15 @@
 # CHANGELOG
 
+## v1.0.3 (in development)
 
+### Feature
+
+* feat: Add compareCellPopulations() function for comparing cell population distributions across experimental groups
+  - Visualizes cell population frequencies or absolute counts across multiple groups
+  - Generates alluvial flow bar plots and faceted box plots
+  - Supports custom group ordering and color palettes
+  - Added ggalluvial dependency for flow visualizations
+  - Generated from JSON template using json2r.prompt.md instructions
 
 ## v1.0.2 (2024-02-01)
 

DESCRIPTION

@@ -39,6 +39,7 @@ Imports:
     gargle (>= 1.2.0),
     ggplot2 (>= 3.3.6),
     ggpubr (>= 0.4.0),
+    ggalluvial,
     globals (>= 0.16.1),
     harmony (>= 0.1.1),
     hdf5r (>= 1.3.5),
@@ -83,8 +84,8 @@ Imports:
     dendextend,
     dendsort,
     pheatmap,
-    scales,
     celldex,
+    scales,
     gdata,
     ggrepel,
     tidyr,

NAMESPACE

@@ -3,15 +3,19 @@
 export(aggregateCounts)
 export(annotateCellTypes)
 export(appendMetadataToSeuratObject)
+export(build_modscore_plots)
 export(colorByGene)
 export(colorByMarkerTable)
 export(combineNormalize)
+export(compareCellPopulations)
+export(compute_modscore_data)
 export(degGeneExpressionMarkers)
 export(dotPlotMet)
 export(dualLabeling)
 export(filterQC)
 export(filterSeuratObjectByMetadata)
 export(heatmapSC)
+export(launch_module_score_app)
 export(modScore)
 export(nameClusters)
 export(object)
@@ -21,7 +25,7 @@ export(processRawData)
 export(reclusterFilteredSeuratObject)
 export(reclusterSeuratObject)
 export(tSNE3D)
-export(violinPlot_mod)
+export(violinPlot)
 import(MAST)
 import(RColorBrewer)
 import(Seurat)
@@ -40,12 +44,14 @@ import(gridExtra)
 import(harmony)
 import(httr)
 import(jsonlite)
+import(magrittr)
 import(parallel)
 import(plotly)
 import(quantmod)
 import(reshape2)
 import(rlang)
 import(scales)
+import(tibble)
 import(tidyverse)
 import(tools)
 import(utils)
@@ -76,6 +82,7 @@ importFrom(dplyr,arrange)
 importFrom(dplyr,case_when)
 importFrom(dplyr,desc)
 importFrom(dplyr,filter)
+importFrom(dplyr,group_by)
 importFrom(dplyr,if_else)
 importFrom(dplyr,mutate)
 importFrom(dplyr,mutate_if)
@@ -86,14 +93,26 @@ importFrom(dplyr,row_number)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(ggExtra,ggMarginal)
+importFrom(ggalluvial,geom_flow)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,coord_fixed)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_hline)
+importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_segment)
+importFrom(ggplot2,geom_violin)
 importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggtitle)
+importFrom(ggplot2,guide_legend)
+importFrom(ggplot2,guides)
+importFrom(ggplot2,scale_color_gradientn)
 importFrom(ggplot2,scale_color_identity)
+importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,scale_y_continuous)
+importFrom(ggplot2,scale_y_log10)
 importFrom(ggplot2,scale_y_reverse)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_bw)
@@ -128,6 +147,7 @@ importFrom(stats,kmeans)
 importFrom(stats,mad)
 importFrom(stats,median)
 importFrom(stats,quantile)
+importFrom(stats,setNames)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_sort)
 importFrom(stringr,str_split_fixed)

R/Compare_Cell_Populations.R

@@ -0,0 +1,263 @@
+#' @title Compare Cell Populations
+#' @description Compare cell population distributions across different groups
+#' using bar plots and box plots. Creates visualizations showing cell type
+#' frequencies or counts across user-defined groupings.
+#' 
+#' @details This function generates comparative visualizations of cell 
+#' populations from a Seurat object. It can display data as either frequency 
+#' percentages or absolute counts, and creates both stacked bar plots 
+#' (with alluvial flow connections) and grouped box plots for comparison 
+#' across samples and conditions.
+#'
+#' @param object A Seurat object containing the single-cell data
+#' @param annotation.column Character string specifying the metadata column 
+#' containing cell type annotations to summarize in the bar plot
+#' @param group.column Character string specifying the metadata column 
+#' defining groups to compare (e.g., treatment conditions)
+#' @param sample.column Character string specifying the metadata column 
+#' containing sample identifiers. Default is "orig.ident"
+#' @param counts.type Character string specifying plot data type: 
+#' "Frequency" (percentages) or "Counts" (absolute numbers). Default is "Frequency"
+#' @param group.order Character vector specifying the order of groups in plots.
+#' If NULL, uses natural order from data. Default is NULL
+#' @param seurat.object.filename Character string for the Seurat object 
+#' filename. Default is "seurat_object.rds"
+#' @param wrap.ncols Integer specifying number of columns for facet wrapping 
+#' in box plots. Default is 5
+#'
+#' @import Seurat
+#' @import ggplot2
+#' @import ggpubr
+#' @import RColorBrewer
+#' @import tibble
+#' @import reshape2
+#' @import data.table
+#' @import dplyr
+#' @import magrittr
+#' @import cowplot
+#' @import gridExtra
+#' @import grid
+#' @import scales
+#'
+#' @importFrom ggalluvial geom_flow
+#' @importFrom stats setNames
+#' @importFrom grDevices colorRampPalette
+#'
+#' @export
+#'
+#' @return A list containing:
+#' \itemize{
+#'   \item \code{Plots} - A list with two ggplot objects:
+#'     \itemize{
+#'       \item \code{Barplot} - Stacked bar plot with alluvial flows
+#'       \item \code{Boxplot} - Faceted box plots by cell type (only if counts.type="Frequency")
+#'     }
+#'   \item \code{Table} - A data.frame with cell counts and percentages
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' # Compare cell populations by treatment group
+#' results <- compareCellPopulations(
+#'   object = seurat_obj,
+#'   annotation.column = "cell_type",
+#'   group.column = "treatment",
+#'   sample.column = "sample_id",
+#'   counts.type = "Frequency"
+#' )
+#' 
+#' # Display plots
+#' plot(results$Plots$Barplot)
+#' plot(results$Plots$Boxplot)
+#' 
+#' # View summary table
+#' head(results$Table)
+#' }
+
+compareCellPopulations <- function(
+  object,
+  annotation.column,
+  group.column,
+  sample.column = "orig.ident",
+  counts.type = "Frequency",
+  group.order = NULL,
+  wrap.ncols = 5
+) {
+
+  ## -------------------------------- ##
+  ## Input Validation                 ##
+  ## -------------------------------- ##
+
+  # Validate object
+  if (!inherits(object, "Seurat")) {
+    stop("Error: 'object' must be a Seurat object")
+  }
+
+  # Validate counts.type
+  if (!counts.type %in% c("Frequency", "Counts")) {
+    stop("Error: 'counts.type' must be either 'Frequency' or 'Counts'")
+  }
+
+  ## --------- ##
+  ## Functions ##
+  ## --------- ##
+
+  createAnnoTable <- function(SO, AnnoCol, GroupCol) {
+    ## Extract annotation data for each group using a 2D contingency table
+    cntMat <- table(SO@meta.data[[AnnoCol]], SO@meta.data[[GroupCol]])
+
+    # Convert to data frame while preserving row/column names
+    cntTble <- as.data.frame.matrix(cntMat)
+    cntTble <- data.frame(
+      lapply(cntTble, function(x) as.numeric(as.character(x))),
+      check.names = FALSE,
+      row.names = rownames(cntTble)
+    )
+
+    freqTble <- apply(cntTble, 2, FUN = function(x) {
+      return(x / sum(x))
+    })
+    freqTble <- (freqTble * 100)
+
+    outTbl <- merge(cntTble, as.data.frame(freqTble),
+                    by = 'row.names',
+                    suffixes = c('_CellCounts', '_Percent'))
+    outTbl <- dplyr::rename(outTbl, 'Clusters' = "Row.names")
+
+    return(list(
+      'CellFreq' = freqTble,
+      'CellCounts' = cntTble,
+      'OutTable' = outTbl
+    ))
+  }
+
+  ## --------------- ##
+  ## Main Code Block ##
+  ## --------------- ##
+
+  # Replace dots with underscores in column names
+  colnames(object@meta.data) <- gsub("\\.", "_", colnames(object@meta.data))
+
+  # Update column names if they were modified
+  annotation.column <- gsub("\\.", "_", annotation.column)
+  group.column <- gsub("\\.", "_", group.column)
+  sample.column <- gsub("\\.", "_", sample.column)
+
+
+  # Validate metadata columns exist
+  required.cols <- c(annotation.column, group.column, sample.column)
+  missing.cols <- setdiff(required.cols, colnames(object@meta.data))
+  if (length(missing.cols) > 0) {
+    stop("Error: The following columns are missing from metadata: ",
+         paste(missing.cols, collapse = ", "))
+  }
+
+
+
+
+  # Set up ordering
+  ordr <- object@meta.data[[annotation.column]] %>% 
+    unique() %>% 
+    sort()
+
+  if (is.null(group.order)) {
+    group.order <- unique(object@meta.data[[group.column]])
+  }
+
+  # Set up colors
+  numColors <- max(
+    length(unique(object@meta.data[[annotation.column]])),
+    20
+  )
+  colpaired <- colorRampPalette(brewer.pal(12, "Paired"))
+  cols <- c(
+    "#e6194B", "#3cb44b", "#4363d8", "#f58231", "#911eb4", "#42d4f4",
+    "#f032e6", "#bfef45", "#fabebe", "#469990", "#e6beff", "#9A6324",
+    "#800000", "#aaffc3", "#808000", "#000075",
+    colpaired(numColors)
+  )
+  names(cols) <- ordr
+
+  object@meta.data[[annotation.column]] <- factor(
+    object@meta.data[[annotation.column]],
+    levels = ordr
+  )
+
+  # Create tables
+  ColTables <- createAnnoTable(object, annotation.column, group.column)
+  BoxTables <- createAnnoTable(object, annotation.column, sample.column)
+
+  metaGroups <- object@meta.data[, c(group.column, sample.column)]
+  rownames(metaGroups) <- NULL
+  metaGroups <- metaGroups %>% unique()
+
+  ## Create plots based on counts type
+  if (counts.type == 'Frequency') {
+    ptbl <- melt(ColTables$CellFreq)
+    ptblBox <- melt(as.matrix(BoxTables$CellFreq))
+    ptblBox <- merge(ptblBox, metaGroups, 
+                     by.x = 'Var2', by.y = sample.column, all.x = TRUE)
+
+    labelCol <- 'PerValue'
+    ylab <- 'Frequency of each cell type (100%)'
+  } else if (counts.type == "Counts") {
+    ptbl <- melt(as.matrix(ColTables$CellCounts))
+    ptblBox <- melt(as.matrix(BoxTables$CellCounts))
+    ptblBox <- merge(ptblBox, metaGroups, 
+                     by.x = 'Var2', by.y = sample.column, all.x = TRUE)
+
+    labelCol <- 'value'
+    ylab <- 'Cell Counts'
+  }
+
+  # Format bar plot data
+  ptbl$Var1 <- factor(ptbl$Var1, levels = ordr)
+  ptbl$value <- round(ptbl$value, 1)
+  ptbl$PerValue <- paste0(ptbl$value, '%')
+  ptbl$PerValue <- gsub('^%$', "_", ptbl$PerValue)
+  ptbl[ptbl$value < 1, 'PerValue'] <- ""
+  ptbl$Var2 <- factor(ptbl$Var2, levels = group.order)
+
+  # Create bar plot with alluvial flows
+  p2 <- ptbl %>%
+    ggplot(aes_string(y = 'value', x = 'Var2', fill = 'Var1', label = labelCol)) +
+    geom_flow(aes(alluvium = Var1), alpha = .2,
+              lty = 2, color = "black",
+              curve_type = "linear",
+              width = .5) +
+    geom_col(aes(fill = Var1), width = .5, color = "black") +
+    geom_text(size = 3, position = position_stack(vjust = 0.5)) +
+    theme_classic() +
+    ylab(ylab) +
+    xlab("") +
+    scale_x_discrete(guide = guide_axis(angle = 45)) +
+    scale_fill_manual(annotation.column, values = cols)
+
+  # Create box plot
+  ptblBox$value <- round(ptblBox$value, 1)
+  ptblBox$PerValue <- paste0(ptblBox$value, '%')
+  ptblBox$PerValue <- gsub('^%$', "_", ptblBox$PerValue)
+  ptblBox[ptblBox$value < 1, 'PerValue'] <- ""
+  ptblBox[[group.column]] <- factor(ptblBox[[group.column]], levels = group.order)
+
+  p2_Box <- ptblBox %>%
+    ggboxplot(y = 'value', x = group.column, add = "jitter", color = "Var1") +
+    facet_wrap(~Var1, ncol = wrap.ncols, scales = 'fixed') +
+    ylab(ylab) +
+    xlab("") +
+    theme(legend.title = element_blank())
+
+  # Return results
+  result <- list(
+    'Plots' = list('Barplot' = p2, 'Boxplot' = p2_Box),
+    'Table' = ColTables$OutTable
+  )
+
+  return(result)
+}
+
+# Add global variables to avoid R CMD check NOTEs
+utils::globalVariables(c(
+  "Var1", "Var2", "value", "PerValue", "alluvium",
+  ".", "CellFreq", "CellCounts", "OutTable"
+))