Update UMAP faceting code

templates/qc_report/celltypes_qc.rmd

@@ -42,6 +42,7 @@ format_celltype_n_table <- function(df) {
 
 #' Function to lump celltype columns in an existing data frame for all of the
 #'  following columns, if they exist: `<singler/cellassign/submitter>_celltype_annotation`.
+#' The cell types will also be renamed via wrapping at the given `wrap` level.
 #'  The resulting lumped column will be named:
 #'  `<singler/cellassign/submitter>_celltype_annotation_lumped`.
 #'
@@ -50,16 +51,28 @@ format_celltype_n_table <- function(df) {
 #' @param n_celltypes Number of groups to lump into, with rest put into "Other" group. Default is 7.
 #'
 #' @return Updated df with new column of lumped celltypes for each present method
-lump_celltypes <- function(df, n_celltypes = 7) {
+lump_wrap_celltypes <- function(df, n_celltypes = 7, wrap = 35) {
   df <- df |>
+    # First, wrap labels
     dplyr::mutate(
       across(
         ends_with("_celltype_annotation"),
-        \(x) forcats::fct_lump_n(x, n_celltypes, other_level = "All remaining cell types", ties.method = "first"),
+        \(x) stringr::str_wrap(x, wrap)
+      )
+    ) |>
+    # Next, apply factor lumping, but ensure final order is via frequency with the "others" at the end
+    dplyr::mutate(
+      across(
+        ends_with("_celltype_annotation"),
+        \(x) {
+          x |>
+            forcats::fct_lump_n(n_celltypes, other_level = "All remaining cell types", ties.method = "first") |>
+            forcats::fct_infreq() |>
+            forcats::fct_relevel("Unknown cell type", "All remaining cell types", after = Inf)
+        },
         .names = "{.col}_lumped"
       )
     )
-
   return(df)
 }
 
@@ -120,14 +133,20 @@ plot_umap <- function(
 #'   In each panel, the cell type of interest is colored and all other cells are grey.
 faceted_umap <- function(umap_df,
                          annotation_column) {
+  # Find total number of cell types for determining legend placement
+  total_celltypes <- umap_df |>
+    dplyr::pull({{ annotation_column }}) |>
+    levels() |>
+    length()
+
   # color by the annotation column but only color one cell type at a time
   faceted_umap <- ggplot(
     umap_df,
     aes(x = UMAP1, y = UMAP2, color = {{ annotation_column }})
   ) +
     # set points for all "other" points
     geom_point(
-      data = select(
+      data = dplyr::select(
         umap_df, -{{ annotation_column }}
       ),
       color = "gray80",
@@ -136,7 +155,10 @@ faceted_umap <- function(umap_df,
     ) +
     # set points for desired cell type
     geom_point(size = 0.3, alpha = 0.5) +
-    facet_wrap(vars({{ annotation_column }})) +
+    facet_wrap(
+      vars({{ annotation_column }}),
+      ncol = 3
+    ) +
     scale_color_brewer(palette = "Dark2") +
     # remove axis numbers and background grid
     scale_x_continuous(labels = NULL, breaks = NULL) +
@@ -150,13 +172,28 @@ faceted_umap <- function(umap_df,
           size = 1.5
         )
       )
-    ) +
-    theme(
-      legend.position = c(.9, 0),
-      legend.justification = c("right", "bottom"),
-      legend.title.align = 0.5
     )
 
+  # Determine legend placement based on total_celltypes
+  if (total_celltypes %% 3 != 0 & total_celltypes != 1) {
+    faceted_umap <- faceted_umap +
+      theme(
+        legend.position = c(0.95, 0),
+        legend.justification = c(1, -0.1),
+        legend.title.align = 0.5,
+        # use slightly smaller legend text, which helps legend fit and prevents
+        #  long wrapped labels from bunching up
+        legend.text = element_text(size = rel(0.85))
+      )
+  } else {
+    faceted_umap <- faceted_umap +
+      theme(
+        legend.position = "bottom"
+      )
+  }
+
+
+
   return(faceted_umap)
 }
 ```
@@ -278,8 +315,8 @@ Clusters were calculated using the graph-based {metadata(processed_sce)$cluster_
 
 
 ```{r, eval = has_umap}
-# Create dataset for plotting UMAPs with lumped cell types
-umap_df <- lump_celltypes(celltype_df)
+# Create dataset for plotting UMAPs with lumped and label-wrapped cell types
+umap_df <- lump_wrap_celltypes(celltype_df)
 ```