Skip to content

Commit

Permalink
fix: table and plot high impact highlights
Browse files Browse the repository at this point in the history
  • Loading branch information
@Nicolai-vKuegelgen
Nicolai-vKuegelgen committed Jun 24, 2024
1 parent f291cde commit c4d4c9c
Show file tree
Hide file tree
Showing 4 changed files with 46 additions and 38 deletions.
4 changes: 2 additions & 2 deletions scripts/R_plotting_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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',
Expand Down
62 changes: 38 additions & 24 deletions scripts/R_table_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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') {
Expand Down Expand Up @@ -70,40 +79,45 @@ 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, ','),
CNV_type = CNVtype_vec) %>%
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', '&#013;'),
out_str = ifelse(
hotspot != "" & !is.na(list_name),
paste0(str_glue('<span class="badge badge-{shorthand}" title="'),
str_glue('{listtype} list name: {list_name}&#013;'), #\\n
ifelse(!is.na(impact_score), str_glue('custom impact_score: {impact_score}&#013;'), ''),
str_glue('Annotation source:&#013;{source}'),
str_glue('">{hotspot}</span>')),
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', '&#013;') %>%
str_replace_all('\\n', '&#013;'),
out_str = ifelse(
hotspot != "" & !is.na(list_name) & do_format,
paste0(str_glue('<span class="badge badge-{shorthand}" title="'),
str_glue('{listname} list name: {list_name}&#013;'), #\\n
ifelse(!is.na(impact_score), str_glue('custom impact_score: {impact_score}&#013;'), ''),
str_glue('Annotation source:&#013;{source}'),
str_glue('">{hotspot}</span>')),
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)
Expand All @@ -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 %>%
Expand All @@ -129,8 +143,8 @@ CNV_table_output <- function(tb, plotsection, caption = NULL) {
# pmap_chr(., CNV_ID_str),' (ext. plot)</a>')
),
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,
Expand Down Expand Up @@ -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)
Expand All @@ -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) %>%
Expand Down
16 changes: 5 additions & 11 deletions scripts/report_template.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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', ...) {
Expand Down Expand Up @@ -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')
Expand Down Expand Up @@ -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')
```

Expand All @@ -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')
```

Expand Down Expand Up @@ -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')
Expand Down
2 changes: 1 addition & 1 deletion supplemental-files/HighImpact-stemcell-hotspots.tsv
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

0 comments on commit c4d4c9c

Please sign in to comment.