diff --git a/scripts/R_plotting_functions.R b/scripts/R_plotting_functions.R index ddbbf3b..0829daf 100644 --- a/scripts/R_plotting_functions.R +++ b/scripts/R_plotting_functions.R @@ -84,8 +84,8 @@ make_LRR_BAF_plots <- function(call.row, y_pos = 0, Sample_Name = paste(sample_headers, collapse = '---'), color = case_when( - str_detect(paste(high_impact_list, collapse = '|'), section_name) ~ 'red', - str_detect(paste(highlight_list, collapse = '|'), section_name) ~ 'orange', + str_detect(section_name, paste(high_impact_list, collapse = '|')) ~ 'red', + str_detect(section_name, paste(highlight_list, collapse = '|')) ~ 'orange', band_staining == 'gpos100' ~ 'black', band_staining == 'gpos50' ~ 'grey30', band_staining == 'gpos25' ~ 'grey70', diff --git a/scripts/R_table_functions.R b/scripts/R_table_functions.R index b207bff..52ddad3 100644 --- a/scripts/R_table_functions.R +++ b/scripts/R_table_functions.R @@ -7,6 +7,15 @@ vector_to_js <- function(v) { } } +format_column_names <- function(n) { + str_replace_all(n, '_', ' ') %>% + str_to_title() %>% + str_replace('Cnv', 'CNV') %>% + str_replace('Loh', 'LOH') %>% + str_replace('Snp', 'SNP') %>% + str_replace('Roi', 'ROI') %>% + str_replace('Id', 'ID') +} simple_table_output <- function(tb, caption=NULL) { if (params$out_format == 'html') { @@ -70,15 +79,13 @@ summary_table <- function(Combined.metrics, Combined.colors, sample_headers) { } -format_hotspots_to_badge <- function(hotspot_vec, CNVtype_vec, listtype = 'high_impact') { - if (listtype == "high_impact") { - gene_details <- high_impact_tb +format_hotspots_to_badge <- function(hotspot_vec, CNVtype_vec, gene_details, listname = 'high_impact') { + if (listname == "high_impact") { shorthand <- 'HI' - } else if (listtype == "highlight") { - gene_details <- highlight_tb + } else if (listname == "highlight") { shorthand <- 'HL' } else { - stop(str_glue("Unsupported list type '{list}', only 'high_impact' and 'highlight' are defined")) + stop(str_glue("Unsupported list type '{listname}', only 'high_impact' and 'highlight' are defined")) } tb <- tibble(hotspot = str_split(hotspot_vec, ','), @@ -86,24 +93,31 @@ format_hotspots_to_badge <- function(hotspot_vec, CNVtype_vec, listtype = 'high_ mutate(id = 1:dplyr::n()) %>% unnest(hotspot) %>% left_join(gene_details) %>% - filter(is.na(call_type) | call_type %in% c(CNV_type, 'any') ) %>% - mutate(source = str_replace_all(source, '\\n', ' '), - out_str = ifelse( - hotspot != "" & !is.na(list_name), - paste0(str_glue('{hotspot}')), - hotspot - ) + mutate( + do_format = case_when( + is.na(call_type) ~ FALSE, + call_type == CNV_type ~ TRUE, + call_type == 'any' ~ TRUE, + TRUE ~ FALSE + ), + source = str_replace_all(source, '\\\\n', ' ') %>% + str_replace_all('\\n', ' '), + out_str = ifelse( + hotspot != "" & !is.na(list_name) & do_format, + paste0(str_glue('{hotspot}')), + hotspot + ) ) %>% group_by(id) %>% summarise( sep = ifelse(all(str_detect(out_str, '^<')), "", ', '), hotspot = base::paste(out_str, collapse='') ) %>% - mutate(hotspot = ifelse(hotspot == 'NA', '-', hotspot)) + mutate(hotspot = ifelse(hotspot %in% c('', 'NA'), '-', hotspot)) if (nrow(tb) == 0 | all(is.na(hotspot_vec) | hotspot_vec == 'NA')) { out_vec <- ifelse(is.na(hotspot_vec), '-', hotspot_vec) @@ -113,7 +127,7 @@ format_hotspots_to_badge <- function(hotspot_vec, CNVtype_vec, listtype = 'high_ } } -CNV_table_output <- function(tb, plotsection, caption = NULL) { +CNV_table_output <- function(tb, plotsection, high_impact_tb, highlight_tb, caption = NULL) { always_include <- report.setting('call.data.and.plots', plotsection, 'always_include') # Reorder & subset columns tb <- tb %>% @@ -129,8 +143,8 @@ CNV_table_output <- function(tb, plotsection, caption = NULL) { # pmap_chr(., CNV_ID_str),' (ext. plot)') ), Precision_Estimate = ifelse(is.na(Precision_Estimate), '-', as.character(Precision_Estimate)), - high_impact_hits = map2_chr(high_impact_hits, CNV_type, \(hi,c) format_hotspots_to_badge(hi, c, 'high_impact')), - highlight_hits = map2_chr(highlight_hits, CNV_type, \(hi,c) format_hotspots_to_badge(hi, c, 'highlight')), + high_impact_hits = map2_chr(high_impact_hits, CNV_type, \(hi,c) format_hotspots_to_badge(hi, c, high_impact_tb, 'high_impact')), + highlight_hits = map2_chr(highlight_hits, CNV_type, \(hi,c) format_hotspots_to_badge(hi, c, highlight_tb, 'highlight')), ) %>% select(sample_id, ID, i, #invis 0-2 Plot, Call_Label, Impact_Score, @@ -211,7 +225,7 @@ CNV_table_output <- function(tb, plotsection, caption = NULL) { } } -gene_table_output <- function(tb, plotsection, caption = NULL, extra_cols = c()) { +gene_table_output <- function(tb, plotsection, high_impact_tb, highlight_tb, caption = NULL, extra_cols = c()) { if (report.setting('call.data.and.plots', plotsection, 'include.gene.table.details') == 'Call') { tb <- filter(tb, direct_hit) @@ -237,8 +251,8 @@ gene_table_output <- function(tb, plotsection, caption = NULL, extra_cols = c()) #Reformat gene name gene_name = ifelse( high_impact == 'hit', - map2_chr(gene_name, CNVtype, \(g, c) format_hotspots_to_badge(g,c, 'high_impact')), - map2_chr(gene_name, CNVtype, \(g, c) format_hotspots_to_badge(g,c, 'highlight')) + map2_chr(gene_name, CNVtype, \(g, c) format_hotspots_to_badge(g,c, high_impact_tb,'high_impact')), + map2_chr(gene_name, CNVtype, \(g, c) format_hotspots_to_badge(g,c, highlight_tb, 'highlight')) ), ) %>% arrange(high_impact, highlight, desc(direct_hit), start) %>% diff --git a/scripts/report_template.Rmd b/scripts/report_template.Rmd index 0fe9c2a..07acecb 100644 --- a/scripts/report_template.Rmd +++ b/scripts/report_template.Rmd @@ -208,13 +208,6 @@ tr_tibble <- function(tb) { ## Rmd related functions -format_column_names <- function(n) { - str_replace_all(n, '_', ' ') %>% str_to_title() %>% - str_replace('Cnv', 'CNV') %>% - str_replace('Loh', 'LOH') %>% - str_replace('Snp', 'SNP') -} - CNV_ID_str <- function(Call_Label, CNV_type, Chr, Size, i, region_name = NULL, formatting = 'nice', ...) { @@ -265,7 +258,8 @@ make_CNV_plot_section <- function(call.table, plotsection = 'denovo') { } if (report.setting('call.data.and.plots', plotsection, 'include.gene.table.details') != 'None') { gene.tb <- res$genes - subchunkify(gene_table_output(gene.tb, plotsection), str_glue('CNV_call.{plotsection}.nr{i}.table.genes')) + subchunkify(gene_table_output(gene.tb, plotsection, high_impact_tb, highlight_tb), + str_glue('CNV_call.{plotsection}.nr{i}.table.genes')) cat('\n\n') } cat('\n\n') @@ -632,7 +626,7 @@ cat('This section describes all de-novo CNV calls, meaning calls without a match ``` ```{r denovo_calls.table, results='asis', eval = include.section('denovo_calls.table')} -CNV_table_output(denovo_calls.table, 'denovo', caption = 'de-novo CNV calls') +CNV_table_output(denovo_calls.table, 'denovo', high_impact_tb, highlight_tb, caption = 'de-novo CNV calls') cat('\n\n') ``` @@ -646,7 +640,7 @@ cat('This section describes all CNV calls that match the reference sample.\n\n') ``` ```{r reference_gt_calls.table, results='asis', eval = !is.na(ref_id) & include.section('reference_gt_calls.table')} -CNV_table_output(reference_calls.table, 'reference_gt', caption = 'reference genotype CNV calls') +CNV_table_output(reference_calls.table, 'reference_gt', high_impact_tb, highlight_tb, caption = 'reference genotype CNV calls') cat('\n\n') ``` @@ -688,7 +682,7 @@ if (any(!is.na(regions)) & length(regions)>0) { bind_rows(expected_final_tb) # Rmd doesn"t auto-print output inside {} - print(CNV_table_output(fake_call_tb, 'regions_of_interest', caption = 'Regions of Interest')) + print(CNV_table_output(fake_call_tb, 'regions_of_interest', high_impact_tb, highlight_tb, caption = 'Regions of Interest')) make_CNV_plot_section(fake_call_tb, 'regions_of_interest') diff --git a/supplemental-files/HighImpact-stemcell-hotspots.tsv b/supplemental-files/HighImpact-stemcell-hotspots.tsv index 6b0cd71..a5d2698 100644 --- a/supplemental-files/HighImpact-stemcell-hotspots.tsv +++ b/supplemental-files/HighImpact-stemcell-hotspots.tsv @@ -9,5 +9,5 @@ StemCell-Hotspots TP53 gene_name any StemCNV-check curation; doi.org/10.1038/s4 StemCell-Hotspots 18q21 gband loss StemCNV-check curation; ISCCR guidelines 2023 StemCell-Hotspots 1q32 gband gain StemCNV-check curation; ISCCR guidelines 2023 StemCell-Hotspots 12p13.3 gband gain StemCNV-check curation; ISCCR guidelines 2023\n doi.org/10.1038/ncomms5825 \n https://doi.org/10.1101/2021.05.22.445238 -StemCell-Hotspots 17q25 gband gain StemCNV-check curation; ISCCR guidelines 2023\n doi.org/10.1016/j.devcel.2021.07.019 \n doi.org/10.1016/j.celrep.2014.12.050 +StemCell-Hotspots 17q25 gband gain StemCNV-check curation; ISCCR guidelines 2023\n doi.org/10.1016/j.devcel.2021.07.019 \n doi.org/10.1016/j.celrep.2014.12.050 StemCell-Hotspots 20q11 gband gain StemCNV-check curation; ISCCR guidelines 2023\n doi.org/10.1016/j.stemcr.2013.10.005 \n doi.org/10.1093/molehr/gat077 \n doi.org/10.1186/1471-2407-6-116 \n doi.org/10.1016/j.stemcr.2019.05.005 \n doi.org/10.1038/nbt.1516