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

analyses/chromosomal-instability/02a-plot-chr-instability-heatmaps.Rmd

@@ -55,11 +55,13 @@ Import color palettes.
 
 ```{r}
 # Import standard color palettes for project
-histology_col_palette <- readr::read_tsv(
-  file.path(figures_dir, "palettes", "histology_color_palette.tsv")
+histology_label_mapping <- readr::read_tsv(
+  file.path(figures_dir, "palettes", "histology_label_color_table.tsv")
   ) %>% 
-  # We'll use deframe so we can use it as a recoding list
-  tibble::deframe()
+  # Select just the columns we will need for plotting
+  dplyr::select(Kids_First_Biospecimen_ID, display_group, display_order, hex_codes) %>% 
+  # Reorder display_group based on display_order
+  dplyr::mutate(display_group = forcats::fct_reorder(display_group, display_order))
 
 # We'll use this for numeric data on the heatmap 
 gradient_col_palette <- readr::read_tsv(
@@ -150,7 +152,7 @@ breaks_heatmap <- function(binned_counts_df,
   # Create the Heatmap annotation object
   hist_annot <- ComplexHeatmap::HeatmapAnnotation(
     df = data.frame(histologies),
-    col = list(short_histology = histologies_colors),
+    col = list(display_group = histologies_colors),
     which = "row",
     show_annotation_name = FALSE
   )
@@ -178,11 +180,7 @@ Set up metadata
 ```{r}
 # Read in the metadata
 metadata <- readr::read_tsv(metadata_file, 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))
+  dplyr::inner_join(histology_label_mapping, by = "Kids_First_Biospecimen_ID")
 ```
 
 Load in the previously localized breakpoint data. 
@@ -235,16 +233,17 @@ Make histology labeling `HeatmapAnnotation` object.
 histologies <-
   data.frame(Kids_First_Biospecimen_ID = common_samples) %>%
   dplyr::inner_join(metadata %>% 
-                      dplyr::select(Kids_First_Biospecimen_ID, short_histology, sample_color)) %>%
-  dplyr::arrange(short_histology) %>% 
+                      dplyr::select(Kids_First_Biospecimen_ID, display_group, hex_codes)) %>%
+  # Arrange by display group
+  dplyr::arrange(display_group) %>% 
   tibble::column_to_rownames("Kids_First_Biospecimen_ID")
 
 # Make color key specific to these samples
-histologies_color_key_filtered <- unique(histologies$sample_color)
-names(histologies_color_key_filtered) <- unique(histologies$short_histology)
+histologies_color_key_filtered <- unique(histologies$hex_codes)
+names(histologies_color_key_filtered) <- unique(histologies$display_group)
 
 # Drop this column so ComplexHeatmap isn't tempted to plot it
-histologies <- dplyr::select(histologies, -sample_color)
+histologies <- dplyr::select(histologies, -hex_codes)
 ```
 
 Make a color function. 

figures/README.md

@@ -58,57 +58,56 @@ Each palette contains an `na_color` that is the same color in all palettes.
 This color should be used for all `NA` values.
 `na_color` is always the last value in the  palette.
 If `na_color` is not needed or is supplied separately to a plotting function, you can use a `dplyr::filter(hex_code != "na_color")` to remove `na_color`.
-Biospecimens without a `short_histology` designation are coded as `none` and assigned the `na_color` in `palettes/histology_color_palette.tsv`.
+
+To see a summary of what colors are used for histology labeling, see [`mapping-histology-labels.nb.html`](./mapping-histology-labels.nb.html)
 
 | Palette File Name | HEX color key | Color Notes | Variable application |
 |--------------|--------------------|-----------|----------------------|
-|`histology_color_palette.tsv`|<br>Adenoma:![f23d3d](https://placehold.it/150x40/f23d3d/FFFFFF?text=f23d3d) <br>ATRT:![731d1d](https://placehold.it/150x40/731d1d/FFFFFF?text=731d1d) <br>Central neurocytoma:![b38686](https://placehold.it/150x40/b38686/FFFFFF?text=b38686) <br>Chondrosarcoma:![cc5c33](https://placehold.it/150x40/cc5c33/FFFFFF?text=cc5c33) <br>Chordoma:![331c0d](https://placehold.it/150x40/331c0d/FFFFFF?text=331c0d) <br>Choroid plexus tumor:![ffb380](https://placehold.it/150x40/ffb380/FFFFFF?text=ffb380) <br>CNS EFT-CIC:![b25f00](https://placehold.it/150x40/b25f00/FFFFFF?text=b25f00) <br>CNS lymphoma:![f2d6b6](https://placehold.it/150x40/f2d6b6/000000?text=f2d6b6) <br>CNS neuroblastoma:![736556](https://placehold.it/150x40/736556/FFFFFF?text=736556) <br>CNS Rhabdomyosarcoma:![ffaa00](https://placehold.it/150x40/ffaa00/FFFFFF?text=ffaa00) <br>CNS sarcoma:![4c3d00](https://placehold.it/150x40/4c3d00/FFFFFF?text=4c3d00) <br>Craniopharyngioma:![e2f200](https://placehold.it/150x40/e2f200/FFFFFF?text=e2f200) <br>DNET:![919926](https://placehold.it/150x40/919926/FFFFFF?text=919926) <br>Dysplasia:![d6f2b6](https://placehold.it/150x40/d6f2b6/000000?text=d6f2b6) <br>Embryonal Tumor:![304d26](https://placehold.it/150x40/304d26/FFFFFF?text=304d26) <br>Ependymoma:![00f241](https://placehold.it/150x40/00f241/FFFFFF?text=00f241) <br>ETMR:![009929](https://placehold.it/150x40/009929/FFFFFF?text=009929) <br>Ganglioglioma:![698c7c](https://placehold.it/150x40/698c7c/FFFFFF?text=698c7c) <br>Germinoma:![39e6c3](https://placehold.it/150x40/39e6c3/FFFFFF?text=39e6c3) <br>Glial-neuronal tumor NOS:![005359](https://placehold.it/150x40/005359/FFFFFF?text=005359) <br>Gliosis:![263233](https://placehold.it/150x40/263233/FFFFFF?text=263233) <br>Hemangioblastoma:![00c2f2](https://placehold.it/150x40/00c2f2/FFFFFF?text=00c2f2) <br>Hemangioma:![40a6ff](https://placehold.it/150x40/40a6ff/FFFFFF?text=40a6ff) <br>HGAT:![406280](https://placehold.it/150x40/406280/FFFFFF?text=406280) <br>Langerhans Cell histiocytosis:![0044ff](https://placehold.it/150x40/0044ff/FFFFFF?text=0044ff) <br>LGAT:![00144d](https://placehold.it/150x40/00144d/FFFFFF?text=00144d) <br>LGMT:![acbbe6](https://placehold.it/150x40/acbbe6/FFFFFF?text=acbbe6) <br>Medulloblastoma:![7373e6](https://placehold.it/150x40/7373e6/FFFFFF?text=7373e6) <br>Meningioma:![3d0099](https://placehold.it/150x40/3d0099/FFFFFF?text=3d0099) <br>MPNST:![c200f2](https://placehold.it/150x40/c200f2/FFFFFF?text=c200f2) <br>Neurofibroma:![917399](https://placehold.it/150x40/917399/FFFFFF?text=917399) <br>na_color:![f1f1f1](https://placehold.it/150x40/f1f1f1/000000?text=f1f1f1) <br>Oligodendroglioma:![f279da](https://placehold.it/150x40/f279da/FFFFFF?text=f279da) <br>Other:![cc0052](https://placehold.it/150x40/cc0052/FFFFFF?text=cc0052) <br>Pineoblastoma:![994d6b](https://placehold.it/150x40/994d6b/FFFFFF?text=994d6b) <br>Schwannoma:![4d2636](https://placehold.it/150x40/4d2636/FFFFFF?text=4d2636) <br>Teratoma:![ffbfd9](https://placehold.it/150x40/ffbfd9/FFFFFF?text=ffbfd9)|a named vector of the hex values that were assigned to each `short_histology` group table|For color-coding by `short_histology` when it's more convenient to assign colors by `short_histology` category.|
 |`gradient_col_palette.tsv`| <br>gradient_0:![f7f7f7](https://placehold.it/150x40/f7f7f7/000000?text=f7f7f7) <br>gradient_1:![f7fcf5](https://placehold.it/150x40/f7fcf5/000000?text=f7fcf5) <br>gradient_2:![e5f5e0](https://placehold.it/150x40/e5f5e0/000000?text=e5f5e0) <br>gradient_3:![c7e9c0](https://placehold.it/150x40/c7e9c0/000000?text=c7e9c0) <br>gradient_4:![a1d99b](https://placehold.it/150x40/a1d99b/FFFFFF?text=a1d99b) <br>gradient_5:![74c476](https://placehold.it/150x40/74c476/FFFFFF?text=74c476) <br>gradient_6:![41ab5d](https://placehold.it/150x40/41ab5d/FFFFFF?text=41ab5d) <br>gradient_7:![238b45](https://placehold.it/150x40/238b45/FFFFFF?text=238b45) <br>gradient_8:![006d2c](https://placehold.it/150x40/006d2c/FFFFFF?text=006d2c) <br>gradient_9:![00441b](https://placehold.it/150x40/00441b/FFFFFF?text=00441b) <br>na_color:![f1f1f1](https://placehold.it/150x40/f1f1f1/000000?text=f1f1f1)|10 hex_codes where gradient_0 is for an absolute `0` but may need to be removed from the palette depending on the application|For numeric data being plotted e.g. tumor mutation burden|
 |`divergent_col_palette.tsv`|<br>divergent_low_5:![053061](https://placehold.it/150x40/053061/FFFFFF?text=053061) <br>divergent_low_4:![2166ac](https://placehold.it/150x40/2166ac/FFFFFF?text=2166ac) <br>divergent_low_3:![4393c3](https://placehold.it/150x40/4393c3/FFFFFF?text=4393c3) <br>divergent_low_2:![92c5de](https://placehold.it/150x40/92c5de/FFFFFF?text=92c5de) <br>divergent_low_1:![d1e5f0](https://placehold.it/150x40/d1e5f0/FFFFFF?text=d1e5f0) <br>divergent_neutral:![f7f7f7](https://placehold.it/150x40/f7f7f7/FFFFFF?text=f7f7f7) <br>divergent_high_1:![fddbc7](https://placehold.it/150x40/fddbc7/FFFFFF?text=fddbc7) <br>divergent_high_2:![f4a582](https://placehold.it/150x40/f4a582/FFFFFF?text=f4a582) <br>divergent_high_3:![d6604d](https://placehold.it/150x40/d6604d/FFFFFF?text=d6604d) <br>divergent_high_4:![b2182b](https://placehold.it/150x40/b2182b/FFFFFF?text=b2182b) <br>divergent_high_5:![67001f](https://placehold.it/150x40/67001f/FFFFFF?text=67001f) <br>na_color:![f1f1f1](https://placehold.it/150x40/f1f1f1/FFFFFF?text=f1f1f1)|12 hex codes where the numbers in the name indicate distance from `divergent_neutral`.|For data has that is bidirectional e.g. Amplification/Deletion values like `seg.mean`|
 |`binary_col_palette.tsv` |<br>binary_1:![2166ac](https://placehold.it/150x40/2166ac/FFFFFF?text=2166ac) <br>binary_2:![b2182b](https://placehold.it/150x40/b2182b/FFFFFF?text=b2182b) <br>na_color:![f1f1f1](https://placehold.it/150x40/f1f1f1/000000?text=f1f1f1)|A vector of two hex codes|For binary variables e.g. presence/absence or Amp/Del as statuses|
 | `oncoprint_color_palette.tsv` | <br>Missense_Mutation:![35978f](https://placehold.it/150x40/35978f/FFFFFF?text=35978f) <br>Nonsense_Mutation:![000000](https://placehold.it/150x40/000000/FFFFFF?text=000000) <br>Frame_Shift_Del:![56B4E9](https://placehold.it/150x40/56B4E9/FFFFFF?text=56B4E9) <br>Frame_Shift_Ins:![FFBBFF](https://placehold.it/150x40/FFBBFF/FFFFFF?text=FFBBFF) <br>Splice_Site:![F0E442](https://placehold.it/150x40/F0E442/FFFFFF?text=F0E442) <br>Translation_Start_Site:![191970](https://placehold.it/150x40/191970/FFFFFF?text=191970) <br>Nonstop_Mutation:![545454](https://placehold.it/150x40/545454/FFFFFF?text=545454) <br>In_Frame_Del:![CAE1FF](https://placehold.it/150x40/CAE1FF/FFFFFF?text=CAE1FF) <br>In_Frame_Ins:![FFE4E1](https://placehold.it/150x40/FFE4E1/FFFFFF?text=FFE4E1) <br>Stop_Codon_Ins:![CC79A7](https://placehold.it/150x40/CC79A7/FFFFFF?text=CC79A7) <br>Start_Codon_Del:![56B4E9](https://placehold.it/150x40/56B4E9/FFFFFF?text=56B4E9) <br>Fusion:![7B68EE](https://placehold.it/150x40/7B68EE/FFFFFF?text=7B68EE) <br>Multi_Hit:![00F021](https://placehold.it/150x40/00F021/FFFFFF?text=00F021) <br>Hom_Deletion:![313695](https://placehold.it/150x40/313695/FFFFFF?text=313695) <br>Hem_Deletion:![abd9e9](https://placehold.it/150x40/abd9e9/FFFFFF?text=abd9e9) <br>amplification:![c51b7d](https://placehold.it/150x40/c51b7d/FFFFFF?text=c51b7d) <br>loss:![0072B2](https://placehold.it/150x40/0072B2/FFFFFF?text=0072B2) <br>gain:![D55E00](https://placehold.it/150x40/D55E00/FFFFFF?text=D55E00) <br>High_Level_Gain:![FF0000](https://placehold.it/150x40/FF0000/FFFFFF?text=FF0000) <br>Multi_Hit_Fusion:![CD96CD](https://placehold.it/150x40/CD96CD/FFFFFF?text=CD96CD) | A named vector of hex codes assigned to each `short_histology` and to each `CNV`, `SNV` and `Fusion` category | For plotting an oncoprint figure, this vector provides hex codes for `CNV`, `SNV`, and `Fusion` categories |
 
 ## Color coding examples in R
 
-#### Example 1) Color coding by `short_histology`.
+#### Example 1) Color coding by histologies
 
-**Step 1)** Read in color palette and format as a named list
+**Step 1)** Read in color palette and select the pertinent columns
 
-```
-histology_col_palette <- readr::read_tsv(
-  file.path("figures", "palettes", "histology_color_palette.tsv")
-  ) %>%
-  # We'll use deframe so we can use it as a recoding list
-  tibble::deframe()
-```
-
-**Step 2)** For any data.frame with a `short_histology` column, recode NAs as "none".
+There's some extra columns in `histology_label_color_table.tsv` that you don't need for plotting per se but are more record-keeping purposes. 
+With the code chunk below, we only import the four columns we need and then do a factor reorder to make sure the `display_group` is in the order declared by `display_order`. 
 
 ```
-metadata <- readr::read_tsv(file.path("data", "pbta-histologies.tsv") %>%
-  # 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")))
+# Import standard color palettes for project
+histology_label_mapping <- readr::read_tsv(
+  file.path(figures_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) %>% 
+  # Reorder display_group based on display_order
+  dplyr::mutate(display_group = forcats::fct_reorder(display_group, display_order))
 ```
 
-**Step 3)** Use dplyr::recode on `short_histology` column to make a new color column.
+**Step 2)** Use `dplyr::inner_join` using `Kids_First_Biospecimen_ID` to join by so you can add on the `hex_codes` and `display_group` for each biospecimen. 
+`display_order` specifies what order the `display_group`s should be displayed.
 
 ```
-metadata <- metadata %>%
-  # Tack on the sample color using the short_histology column and a recode
-  dplyr::mutate(sample_color = dplyr::recode(short_histology,
-                                             !!!histology_col_palette))
+# Read in the metadata
+metadata <- readr::read_tsv(metadata_file, guess_max = 10000) %>%
+  dplyr::inner_join(histology_label_mapping, by = "Kids_First_Biospecimen_ID")
 ```
 
-**Step 4)** Make your plot and use the `sample_color` column.  
+**Step 4)** Make your plot and use the `hex_codes` and `display_group` columns.  
 
-Using the `ggplot2::scale_fill_identity()` or `ggplot2::scale_color_identity()` allows you to supply the `hex_code` column from a color palette to `ggplot2` with a `fill` or `color` argument respectively.
-For base R plots, you should be able to supply the `sample_color` column as your `col` argument.
+Using the `ggplot2::scale_fill_identity()` or `ggplot2::scale_color_identity()` allows you to supply the `hex_codes` column from a color palette to `ggplot2` with a `fill` or `color` argument respectively.
+For base R plots, you should be able to supply the `hex_codes` column as your `col` argument.
+`display_group` should be used as the labels in the plot.
 
 ```
 metadata %>%
-  dplyr::group_by(short_histology, sample_color) %>%
+  dplyr::group_by(display_group, hex_codes) %>%
   dplyr::summarize(count = dplyr::n()) %>%
-  ggplot2::ggplot(ggplot2::aes(x = short_histology, y = count, fill = sample_color)) +
+  ggplot2::ggplot(ggplot2::aes(x = display_group, y = count, fill = hex_codes)) +
   ggplot2::geom_bar(stat = "identity") +
   ggplot2::scale_fill_identity()
 ```
@@ -164,14 +163,16 @@ df <- df %>%
 
 ComplexHeatmap::Heatmap(
   df,
-  col = col_fun, 
+  col = col_fun,
   na_col = na_color$hex_codes
 )
 ```
 
 ### Updating color palettes
 
-The color palette TSV files are created by running `scripts/color_palettes.R`, which can be called by `Rscript scripts/color_palettes.R`.
+The non-histologies color palette TSV files are created by running `scripts/color_palettes.R`, which can be called by `Rscript scripts/color_palettes.R`.
 Hex codes for the palettes are hard-coded in this script.
 The script can be called from anywhere in this repository (will look for the `.git` file).
 The hex codes table in `figures/README.md` and its swatches should also be updated by using the `swatches_table` function at the end of the script and copy and pasting this function's output to the appropriate place in the table.
+
+The histology color palette file is created by running `Rscript -e "rmarkdown::render('figures/mapping-histology-labels.Rmd', clean = TRUE)"`.

figures/generate-figures.sh

@@ -22,6 +22,10 @@ scratch_dir="$BASEDIR/scratch"
 # Make output folders for all figures
 mkdir -p pngs
 
+#### Make sure histology_label_color_table.tsv is up to date
+
+Rscript -e "rmarkdown::render('figures/mapping-histology-labels.Rmd', clean = TRUE)"
+
 ################ Sample distribution
 # Run sample distribution analysis
 bash ${analyses_dir}/sample-distribution-analysis/run-sample-distribution.sh
@@ -106,7 +110,7 @@ bash ${analyses_dir}/copy_number_consensus_call/run_consensus_call.sh
 Rscript -e "rmarkdown::render('${analyses_dir}/cnv-chrom-plot/cn_status_heatmap.Rmd',
                               clean = TRUE, params = list(final_figure=TRUE))"
 
-							  
+
 ####### Telomerase Activities
 
 
@@ -118,4 +122,3 @@ Rscript --vanilla 01-run-EXTEND.R --input ${analyses_dir}/collapse-rnaseq/result
 
 # Build figures of telomerase activity
 Rscript --vanilla scripts/TelomeraseActivitites.R
-

figures/mapping-histology-labels.Rmd

@@ -172,6 +172,26 @@ if (nrow(display_group_df) > 17) {
 }
 ```
 
+# Make `display_order`
+
+Get ranks in order of big to small and make them into a new column in `display_group_df`. 
+We will always want the "normal", "benign", "other_tumor" groups to come last so we will push then to the end of the factor order. 
+
+```{r}
+display_order_df <- display_group_df %>% 
+  dplyr::mutate(display_group = forcats::fct_reorder(display_group, n, .desc = TRUE) %>%
+                  forcats::fct_relevel("benign", "other tumor", "normal", after = Inf),
+                display_order = as.numeric(display_group)) # save the factor order for text table export
+```
+
+Add on the `display_order` column using `inner_join`.
+
+```{r}
+histology_table <- histology_table %>%
+  # Join on the display orders
+  dplyr::inner_join(display_order_df, by = "display_group") 
+```
+
 # Add hex codes 
 
 These hex codes were retrieved from http://phrogz.net/css/distinct-colors.html with the settings on default for 18 colors.