Using mapping histology groups for plotting -- Part 2 implemention (PR 2 of 4)

analyses/cnv-chrom-plot/cn_status_heatmap.Rmd

@@ -87,11 +87,11 @@ Import color palettes.
 
 ```{r}
 # Import standard color palettes for project
-histology_col_palette <- readr::read_tsv(
-  file.path(figure_dir, "palettes", "histology_color_palette.tsv")
-) %>%
-  # We'll use deframe so we can use it as a recoding list
-  tibble::deframe()
+histology_label_mapping <- readr::read_tsv(
+  file.path(figure_dir, "palettes", "histology_label_color_table.tsv")
+  ) %>% 
+  # Select just the columns we will need for plotting
+  dplyr::select(Kids_First_Biospecimen_ID, display_group, display_order, hex_codes) 
 ```
 
 Read in the divergent color palette and set it up with three colors. 
@@ -114,13 +114,8 @@ divergent_col_palette <- readr::read_tsv(
 # Read in metadata
 metadata <-
   readr::read_tsv(file.path(input_dir, "pbta-histologies.tsv"), guess_max = 10000) %>%
-  # Easier to deal with NA short histologies if they are labeled something different
-  dplyr::mutate(short_histology = as.character(tidyr::replace_na(short_histology, "none"))) %>%
-  # Tack on the sample color using the short_histology column and a recode
-  dplyr::mutate(sample_color = dplyr::recode(
-    short_histology,
-    !!!histology_col_palette
-  ))
+  # Join on the colors 
+  dplyr::left_join(histology_label_mapping, by = "Kids_First_Biospecimen_ID")
 ```
 
 ### Set up consensus copy number data
@@ -145,7 +140,7 @@ seg_data <- seg_data %>%
     dplyr::select(
       metadata,
       "Kids_First_Biospecimen_ID",
-      "short_histology",
+      "display_group",
       "tumor_ploidy"
     ),
     by = c("ID" = "Kids_First_Biospecimen_ID")
@@ -179,7 +174,7 @@ seg_ranges <- GenomicRanges::GRanges(
     end = seg_data$loc.end
   ),
   status = seg_data$status,
-  histology = seg_data$short_histology,
+  histology = seg_data$display_group,
   biospecimen = seg_data$ID
 )
 ```
@@ -380,51 +375,36 @@ This annotation object strategy was originally from [chromosomal-instability](ht
 histologies <-
   data.frame(Kids_First_Biospecimen_ID = bin_calls_df$biospecimen_id) %>%
   dplyr::inner_join(metadata %>%
-    dplyr::select(Kids_First_Biospecimen_ID, short_histology, sample_color)) %>%
+    dplyr::select(Kids_First_Biospecimen_ID, display_group, display_order, hex_codes)) %>%
   # Count numbers of samples per histology group and make new variable with counts
-  dplyr::group_by(short_histology) %>% 
-  dplyr::mutate(group_n = dplyr::n()) %>% 
-  # Ungroup the data
-  dplyr::ungroup() %>% 
-  # Temporarily we will put the n = 1 `short_histology` samples in the `Other` group. 
-  #TODO: Remove lines 387 - 400 when this is split into two panels
-  dplyr::mutate(
-    short_histology = dplyr::case_when(
-      group_n < min_group_size ~ "Other", 
-      TRUE ~ as.character(short_histology))) %>% 
-  # Reapply colors to groups
-   dplyr::mutate(sample_color = dplyr::recode(
-    short_histology,
-    !!!histology_col_palette
-  )) %>%
-  # ReCount numbers after the Other switches
-  dplyr::group_by(short_histology) %>% 
+  dplyr::group_by(display_group) %>% 
   dplyr::mutate(group_n = dplyr::n()) %>% 
   # Ungroup the data
   dplyr::ungroup() %>% 
   # Add sample sizes
-  dplyr::mutate(short_histology = factor(paste0(short_histology, " (n = ", group_n, ")"))) %>%
-  # Put in alphabetical order
-  dplyr::arrange(short_histology) %>%
-  # ComplexHeatmap wants this. 
-  tibble::column_to_rownames("Kids_First_Biospecimen_ID")
+  dplyr::mutate(display_group = factor(paste0(display_group, " (n = ", group_n, ")"))) %>% 
+  # Reorder display_group based on display_order
+  dplyr::mutate(display_group = forcats::fct_reorder(display_group, display_order)) %>%
+  # Make sure they are in display_order
+  dplyr::arrange(display_order) %>%
+  # Store as rownames
+  tibble::column_to_rownames("Kids_First_Biospecimen_ID") %>%
+  # We don't want this to actually be displayed on the heatmap though
+  dplyr::select(-display_order)
 ```
 
 Make a color key that's formatted for ComplexHeatmap. 
 
 ```{r}
 # Make color key specific to these samples
-histologies_color_key_filtered <- unique(histologies$sample_color)
-names(histologies_color_key_filtered) <- unique(histologies$short_histology)
-
-# Drop this column so ComplexHeatmap isn't tempted to plot it
-histologies <- dplyr::select(histologies, -sample_color, -group_n)
+histologies_color_key_filtered <- unique(histologies$hex_codes)
+names(histologies_color_key_filtered) <- unique(histologies$display_group)
 
 # Get coordinate start positions
-hist_start <- match(names(histologies_color_key_filtered), histologies$short_histology)
+hist_start <- match(names(histologies_color_key_filtered), histologies$display_group)
 
 # Get coordinate end positions for each histology group
-hist_end <- hist_start + summary(histologies$short_histology)
+hist_end <- hist_start + summary(histologies$display_group)
 
 # Get mid points of 
 mid_points <- floor((hist_start + hist_end) /2)
@@ -434,7 +414,7 @@ mid_points <- floor((hist_start + hist_end) /2)
 # Make text labels for chromosome text
 hist_text <- ComplexHeatmap::anno_mark(
   at = mid_points,
-  labels = levels(histologies$short_histology),
+  labels = levels(histologies$display_group),
   which = "row",
   side = "right",
   labels_gp = grid::gpar(cex = 0.65),
@@ -443,8 +423,8 @@ hist_text <- ComplexHeatmap::anno_mark(
 
 # Create the Heatmap annotation object
 hist_annot <- ComplexHeatmap::HeatmapAnnotation(
-  df = data.frame(histologies),
-  col = list(short_histology = histologies_color_key_filtered),
+  df = data.frame(histologies) %>% dplyr::select(-group_n, -hex_codes),
+  col = list(display_group = histologies_color_key_filtered),
   which = "row",
   show_annotation_name = FALSE,
   show_legend = FALSE,
@@ -475,7 +455,7 @@ heatmap <- ComplexHeatmap::Heatmap(
   bin_calls_mat,
   name = "CN status",
   col = color_key,
-  row_split = histologies$short_histology,
+  row_split = histologies$display_group,
   cluster_columns = FALSE,
   cluster_rows = FALSE,
   rect_gp = grid::gpar(col = "black", lwd = .0005),