Do not show cell types with no metacells in the 'Markers' tab

fixes issue #161
tanaylab · Sep 25, 2024 · d902b9f · d902b9f
1 parent 588e345
commit d902b9f
Show file tree

Hide file tree

Showing 6 changed files with 16 additions and 8 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,7 @@
 
 * Search genes by `startsWith` instead of `contains`.
 * Slightly larger default point size in gene/gene plots.
+* Do not show cell types with no metacells in the 'Markers' tab (issue #161).
 
 # MCView 0.2.31 
 

diff --git a/R/mod_cell_type.R b/R/mod_cell_type.R
@@ -71,7 +71,7 @@ mod_cell_type_server <- function(id, dataset, metacell_types, cell_type_colors,
 
             render_axis_select_ui("boxplot_axis", "Data", "boxplot_axis_select", md_choices = dataset_metadata_fields(dataset()), md_selected = dataset_metadata_fields(dataset())[1], selected_gene = default_gene1, input = input, output = output, ns = ns, dataset = dataset, gene_modules = gene_modules, session = session)
 
-            output$cell_type_list <- cell_type_selector(dataset, ns, id = "boxplot_cell_types", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors)
+            output$cell_type_list <- cell_type_selector(dataset, ns, id = "boxplot_cell_types", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors, metacell_types = metacell_types)
 
             output$confusion_color_by_selector <- renderUI({
                 shinyWidgets::prettyRadioButtons(

diff --git a/R/mod_query.R b/R/mod_query.R
@@ -351,7 +351,7 @@ mod_query_server <- function(id, dataset, metacell_types, cell_type_colors, gene
 
             output$plot_mc_stacked_type <- plot_type_predictions_bar(dataset, metacell_types, cell_type_colors)
 
-            output$gene_metadata_cell_type_selector <- cell_type_selector(dataset, ns, id = "gene_metadata_cell_type", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors)
+            output$gene_metadata_cell_type_selector <- cell_type_selector(dataset, ns, id = "gene_metadata_cell_type", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors, metacell_types = metacell_types)
 
             current_gene_table <- reactiveVal()
 

diff --git a/R/mod_samples.R b/R/mod_samples.R
@@ -124,7 +124,7 @@ mod_samples_server <- function(id, dataset, metacell_types, cell_type_colors, ge
             ns <- session$ns
             top_correlated_selectors(input, output, session, dataset, ns, button_labels = c("X", "Y", "Color"), gene_modules = gene_modules)
 
-            output$cell_type_list <- cell_type_selector(dataset, ns, id = "selected_cell_types", label = "Cell types", cell_type_colors = cell_type_colors)
+            output$cell_type_list <- cell_type_selector(dataset, ns, id = "selected_cell_types", label = "Cell types", cell_type_colors = cell_type_colors, metacell_types = metacell_types)
 
             observe({
                 choices <- c(dataset_cell_metadata_fields_numeric(dataset()), "Default")

diff --git a/R/utils_heatmap.R b/R/utils_heatmap.R
@@ -407,7 +407,7 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
 
             heatmap_matrix_reactives(ns, input, output, session, dataset, metacell_types, cell_type_colors, globals, markers, lfp_range, mode, metacell_filter, mat)
 
-            output$cell_type_list <- cell_type_selector(dataset, ns, id = "selected_cell_types", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors)
+            output$cell_type_list <- cell_type_selector(dataset, ns, id = "selected_cell_types", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors, metacell_types = metacell_types)
 
             output$metadata_list <- metadata_selector(dataset, ns, id = "selected_md", label = "Metadata", metadata_id = "metadata", additional_fields = "Clipboard")
 
@@ -486,13 +486,15 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
                 {
                     req(cell_type_colors())
                     req(input$plot_legend)
-                    legend_point_size <- max(1, min(2, 250 / nrow(cell_type_colors())))
-                    p <- cell_type_colors() %>%
+                    colors <- cell_type_colors()
+                    colors <- colors %>% filter(cell_type %in% metacell_types()$cell_type)
+                    legend_point_size <- max(1, min(2, 250 / nrow(colors)))
+                    p <- colors %>%
                         ggplot(aes(x = cell_type, fill = cell_type, y = 1))
 
                     if (input$plot_cell_type_legend) {
                         p <- p + geom_point(shape = 21) +
-                            scale_fill_manual("Cell types", values = deframe(cell_type_colors() %>% select(cell_type, color))) +
+                            scale_fill_manual("Cell types", values = deframe(colors %>% select(cell_type, color))) +
                             guides(fill = guide_legend(override.aes = list(size = legend_point_size), ncol = 1))
                     }
 

diff --git a/R/utils_selectors.R b/R/utils_selectors.R
@@ -1,10 +1,15 @@
-cell_type_selector <- function(dataset, ns, id = "selected_cell_types", label = "Cell types", selected = NULL, cell_type_colors = NULL) {
+cell_type_selector <- function(dataset, ns, id = "selected_cell_types", label = "Cell types", selected = NULL, cell_type_colors = NULL, metacell_types = NULL) {
     renderUI({
         if (is.null(cell_type_colors)) {
             colors <- NULL
         } else {
             colors <- cell_type_colors()
         }
+
+        if (!is.null(metacell_types)) {
+            colors <- colors %>% filter(cell_type %in% metacell_types()$cell_type)
+        }
+
         cell_types_hex <- col2hex(get_cell_type_colors(dataset(), colors))
         cell_types <- names(get_cell_type_colors(dataset(), colors))