Merge pull request #253 from sigven/dev

Fix bug in parsing of relative CDS start position
sigven · Oct 11, 2024 · dc880a2 · dc880a2
2 parents 44ced32 + d64eb2a
commit dc880a2
Show file tree

Hide file tree

Showing 15 changed files with 298 additions and 158 deletions.
diff --git a/README.md b/README.md
@@ -28,6 +28,10 @@ PCGR originates from the [Norwegian Cancer Genomics Consortium (NCGC)](https://c
 
 ### Top News
 
+- *October 11th 2024:* **2.1.1 release**
+  - patch to fix [bug](https://github.com/sigven/pcgr/issues/252) with parsing of relative CDS start positions
+  - [CHANGELOG](https://sigven.github.io/pcgr/articles/CHANGELOG.html)
+
 - *September 29th 2024*: **2.1.0 release**
   - updated bundle, more oncogenic variants, CNA visualization, 
     improved RNA-seq support, bug fixes, and more

diff --git a/pcgr/annoutils.py b/pcgr/annoutils.py
@@ -401,7 +401,7 @@ def assign_cds_exon_intron_annotations(csq_record, logger):
             varkey_info = str(csq_record['VARKEY']).split('_')            
             if not csq_record['CDS_START'] is None:
                 if len(varkey_info) == 4:
-                    csq_record['CDS_DISTANCE'] = abs(int(csq_record['CDS_START']) - int(csq_record['VARKEY'].split('_')[1]))
+                    csq_record['CDS_DISTANCE'] = abs(int(float(csq_record['CDS_START'])) - int(csq_record['VARKEY'].split('_')[1]))
                     cds_dna_alteration = str(varkey_info[2]) + '>' + str(varkey_info[3])
                     if csq_record['STRAND'] == '-1':
                         cds_dna_alteration = reverse_complement_dna(str(varkey_info[2])) + '>' + reverse_complement_dna(str(varkey_info[3]))

diff --git a/pcgrr/NAMESPACE b/pcgrr/NAMESPACE
@@ -44,6 +44,7 @@ export(get_clin_assocs_cna)
 export(get_dt_tables)
 export(get_excel_sheets)
 export(get_genome_obj)
+export(get_oncogenic_cna_events)
 export(get_prevalent_site_signatures)
 export(get_valid_chromosomes)
 export(get_variant_statistics)
@@ -85,6 +86,7 @@ export(msi_indel_fraction_plot)
 export(msi_indel_load_plot)
 export(order_variants)
 export(plot_cna_segments)
+export(plot_signature_contributions)
 export(plot_tmb_primary_site_tcga)
 export(plot_value_boxes)
 export(pon_status)

diff --git a/pcgrr/R/cna.R b/pcgrr/R/cna.R
@@ -65,6 +65,7 @@ plot_cna_segments <- function(chrom_coordinates = NULL,
     quiet = T
   )
 
+  ## Check required column names of cna_genes data frame
   assertable::assert_colnames(
     cna_gene,
     c("CHROM",
@@ -84,7 +85,8 @@ plot_cna_segments <- function(chrom_coordinates = NULL,
   )
 
 
-  ## Identify segments that involve oncogene gain or tumor suppressor loss
+  ## Identify segments that involve oncogene gain or
+  ## tumor suppressor loss
   onc_gain_tsg_loss <- cna_gene |>
     dplyr::select(
       c("CHROM", "SEGMENT_START", "SEGMENT_END",
@@ -100,7 +102,8 @@ plot_cna_segments <- function(chrom_coordinates = NULL,
   tsg_loss <- data.frame()
   onc_gain <- data.frame()
 
-  ## If there are oncogene gains or tumor suppressor losses, prepare data for plotting
+  ## If there are oncogene gains or tumor suppressor losses,
+  ## prepare data for plotting
   if(NROW(onc_gain_tsg_loss) > 0){
     onc_gain <- onc_gain_tsg_loss |>
       dplyr::filter(
@@ -307,3 +310,91 @@ plot_cna_segments <- function(chrom_coordinates = NULL,
 
 }
 
+
+#' Get oncogenic copy number events
+#'
+#' Function that extracts oncogenic copy number events from
+#' a data frame of annotated transcripts (within copy number segments),
+#' utilizing oncogene/tumor suppressor status and copy number
+#' variant class (gain/loss). This set is used to highlight
+#' copy-altered transcripts that are presumably oncogenic, yet
+#' not actionable _per se_.
+#'
+#' @param cna_df_display data frame with transcript annotations per
+#' copy number segment
+#'
+#' @export
+#'
+get_oncogenic_cna_events <- function(cna_df_display = NULL){
+
+  cna_oncogenic_events <- data.frame()
+
+  assertthat::assert_that(
+    !is.null(cna_df_display)
+  )
+  assertthat::assert_that(
+    is.data.frame(cna_df_display))
+  if(NROW(cna_df_display) == 0){
+    return(cna_oncogenic_events)
+  }
+  assertable::assert_colnames(
+    cna_df_display,
+    c("ACTIONABILITY_TIER",
+      "ONCOGENE",
+      "TUMOR_SUPPRESSOR",
+      "VARIANT_CLASS"),
+    only_colnames = FALSE,
+    quiet = TRUE)
+
+  assertthat::assert_that(
+    is.numeric(cna_df_display$ACTIONABILITY_TIER),
+    is.logical(cna_df_display$ONCOGENE),
+    is.logical(cna_df_display$TUMOR_SUPPRESSOR),
+    is.character(cna_df_display$VARIANT_CLASS)
+  )
+
+  oncogene_gain_variants <-
+    dplyr::filter(
+      cna_df_display,
+      !is.na(.data$ACTIONABILITY_TIER) &
+        .data$ACTIONABILITY_TIER == 3 &
+        .data$ONCOGENE == TRUE &
+        .data$VARIANT_CLASS == "gain") |>
+    dplyr::select(
+      dplyr::any_of(
+        pcgrr::dt_display$cna_other_oncogenic
+      )
+    )
+
+  tsgene_loss_variants <-
+    dplyr::filter(
+      cna_df_display,
+      !is.na(.data$ACTIONABILITY_TIER) &
+        .data$ACTIONABILITY_TIER == 3 &
+        .data$TUMOR_SUPPRESSOR == TRUE &
+        .data$VARIANT_CLASS == "homdel") |>
+    dplyr::select(
+      dplyr::any_of(
+        pcgrr::dt_display$cna_other_oncogenic
+      )
+    )
+
+  cna_oncogenic_events <-
+    dplyr::bind_rows(
+      oncogene_gain_variants,
+      tsgene_loss_variants
+    ) |>
+    dplyr::select(
+      dplyr::any_of(
+        pcgrr::dt_display$cna_other_oncogenic
+      )
+    ) |>
+    dplyr::arrange(
+      dplyr::desc(.data$TISSUE_ASSOC_RANK),
+      dplyr::desc(.data$GLOBAL_ASSOC_RANK),
+    )
+
+  return(cna_oncogenic_events)
+
+
+}
diff --git a/pcgrr/R/mutational_signatures.R b/pcgrr/R/mutational_signatures.R
@@ -857,3 +857,94 @@ mutpat_resample_mut_mat <- function(mut_matrix) {
   })
   return(mut_mat_resampled)
 }
+
+#' Function that makes plots of mutational signature contributions
+#' in a given sample (both ggplot and plotly)
+#'
+#'
+#' @param signature_contributions A list with two dataframes: 'per_group' and
+#' 'per_signature'.
+#' @param per_signature Logical. If TRUE, the plot will show the contribution
+#' per signature. If FALSE, the plot will show the contribution per group.
+#'
+#' @export
+#'
+plot_signature_contributions <- function(
+    signature_contributions = NULL,
+    per_signature = TRUE){
+
+  assertthat::assert_that(
+    is.list(signature_contributions),
+    msg = "'signature_contributions' must be a list")
+
+  assertthat::assert_that(
+    length(signature_contributions) > 0,
+    msg = "'signature_contributions' must have at least one element")
+
+  assertthat::assert_that(
+    all(names(signature_contributions) %in%
+          c("per_group", "per_signature")),
+    msg = paste0("All elements of 'signature_contributions' must be ",
+                 "named 'per_group' and 'per_signature'"))
+
+  assertable::assert_colnames(
+    signature_contributions[['per_group']],
+    c("group", "prop_group", "signature_id_group"),
+    only_colnames = T, quiet = T)
+
+  assertable::assert_colnames(
+    signature_contributions[['per_signature']],
+    c("signature_id", "sample_id", "prop_signature","group",
+      "prop_signature_ci_lower", "prop_signature_ci_upper"),
+    only_colnames = F, quiet = T)
+
+  plot_data_per_signature <-
+    signature_contributions[['per_signature']] |>
+    dplyr::mutate(signature_aetiology = paste0(
+      signature_id, " - ", group)) |>
+    dplyr::mutate(prop_signature = round(prop_signature, digits = 4)) |>
+    dplyr::mutate(prop_signature_ci_lower = round(
+      prop_signature_ci_lower, digits = 4)) |>
+    dplyr::mutate(prop_signature_ci_upper = round(
+      prop_signature_ci_upper, digits = 4)) |>
+    dplyr::mutate(
+      signature_aetiology = factor(
+        signature_aetiology, levels = signature_aetiology))
+
+  signature_contribution_plot <- ggplot2::ggplot(
+    head(plot_data_per_signature, 6),
+    ggplot2::aes(
+      x = reorder(signature_aetiology, -prop_signature),
+      y = prop_signature,
+      fill = signature_aetiology)) +
+    ggplot2::geom_bar(stat = "identity") +
+    ggplot2::geom_errorbar(
+      ggplot2::aes(ymin = prop_signature_ci_lower,
+                   ymax = prop_signature_ci_upper),
+      width = .3)+
+    ggplot2::scale_fill_manual(
+      values = head(
+        pcgrr::color_palette$tier$values,
+        NROW(plot_data_per_signature))) +
+    ggplot2::theme_classic() +
+    ggplot2::xlab("") +
+    ggplot2::ylab("Relative contribution") +
+    ggplot2::theme(
+      legend.position = "bottom",
+      legend.title = ggplot2::element_blank(),
+      plot.margin = ggplot2::margin(0.5, 0.5, 0.5, 0.5, "cm"),
+      axis.text.x = ggplot2::element_blank(),
+      axis.title.y = ggplot2::element_text(family = "Helvetica", size = 13),
+      axis.text.y = ggplot2::element_text(family = "Helvetica", size = 13),
+      legend.text = ggplot2::element_text(family = "Helvetica", size = 12))
+
+
+  pltly_plot <- plotly::ggplotly(signature_contribution_plot)
+  pltly_plot$x$layout$legend$title$text <- ""
+
+  return(list('ggplot' = signature_contribution_plot,
+              'plotly' = pltly_plot))
+
+
+}
+
diff --git a/pcgrr/inst/templates/pcgr_quarto_report/cna.qmd b/pcgrr/inst/templates/pcgr_quarto_report/cna.qmd
@@ -361,50 +361,9 @@ Gene symbols are color-coded according to their strength of association to cance
 
 ```{r }
 
-oncogene_gain_variants <- 
-  dplyr::filter(
-    pcg_report[["content"]][["cna"]][["callset"]][["variant_display"]],
-    !is.na(.data$ACTIONABILITY_TIER) & 
-    .data$ACTIONABILITY_TIER == 3 & 
-      .data$ONCOGENE == TRUE & 
-      .data$VARIANT_CLASS == "gain") |>
-  dplyr::select(
-    dplyr::any_of(
-      pcgrr::dt_display$cna_other_oncogenic
-    )
-  )
-
-tsgene_loss_variants <- 
-  dplyr::filter(
-    pcg_report[["content"]][["cna"]][["callset"]][["variant_display"]],
-    !is.na(.data$ACTIONABILITY_TIER) & 
-      .data$ACTIONABILITY_TIER == 3 & 
-      .data$TUMOR_SUPPRESSOR == TRUE & 
-      .data$VARIANT_CLASS == "homdel") |>
-  dplyr::select(
-    dplyr::any_of(
-      pcgrr::dt_display$cna_other_oncogenic
-    )
-  )
 
-dt_other_oncogenic <- 
-  dplyr::bind_rows(
-    oncogene_gain_variants,
-    tsgene_loss_variants
-  ) |>
-  dplyr::select(
-    dplyr::any_of(
-      pcgrr::dt_display$cna_other_oncogenic
-    )
-  ) |>
-  dplyr::arrange(
-    dplyr::desc(.data$TISSUE_ASSOC_RANK),
-    dplyr::desc(.data$GLOBAL_ASSOC_RANK),
-  )
-
-# if(expression_present_cna == FALSE){
-#   dt_other_oncogenic$TPM_GENE <- NULL
-# }
+dt_other_oncogenic <- pcgrr::get_oncogenic_cna_events(
+  cna_df_display = pcg_report[["content"]][["cna"]][["callset"]][["variant_display"]])
 
 dt_other_oncongenic_cna <- DT::datatable(
   dt_other_oncogenic,
@@ -432,19 +391,6 @@ dt_other_oncongenic_cna <- DT::datatable(
        )
    )
 
-# if(expression_present_cna == TRUE){
-#   dt_other_oncongenic_cna <- dt_other_oncongenic_cna |>
-#     DT::formatStyle(
-#      "TPM_GENE",
-#      "TPM_GENE", 
-#      color = "white", 
-#      backgroundColor = 
-#        DT::styleInterval(
-#          pcgrr::color_palette$gene_expression$breaks,
-#          pcgrr::color_palette$gene_expression$values
-#        )
-#    )
-# }
 
 dt_other_oncongenic_cna
 

diff --git a/pcgrr/inst/templates/pcgr_quarto_report/germline.qmd b/pcgrr/inst/templates/pcgr_quarto_report/germline.qmd
@@ -25,7 +25,7 @@ if(pcg_report[['content']][['germline_classified']][['panel_info']][['panel_id']
 
 * Based on a germline variant analysis of the query case using the [Cancer Predisposition Sequencing Reporter (CPSR)](https://github.com/sigven/cpsr), we here list the variants of clinical significance in cancer predisposition genes, both novel (not recorded in ClinVar), and those with existing classifications in ClinVar.
     * Virtual panel of cancer predisposition genes screened: `r panel_link`
-    * Variants of uncertain significance shown: __`r !pcg_report$settings$conf$germline$ignore_vus`__
+    * Protein-coding variants of uncertain significance shown: __`r !pcg_report$settings$conf$germline$ignore_vus`__
 
 
 ```{r cpsr_clinvar_findings}

diff --git a/pcgrr/inst/templates/pcgr_quarto_report/mutational_signature.qmd b/pcgrr/inst/templates/pcgr_quarto_report/mutational_signature.qmd
@@ -166,46 +166,12 @@ cat("\n\n::: {.callout-important}\n\n## Suboptimal fit of mutational profile\n\n
 #| output: asis
 
 
-plot_data <- 
-  msig_content$result$contributions$per_signature |>
-  dplyr::mutate(signature_aetiology = paste0(signature_id, " - ", group)) |>
-  dplyr::mutate(prop_signature = round(prop_signature, digits = 4)) |>
-  dplyr::mutate(prop_signature_ci_lower = round(
-    prop_signature_ci_lower, digits = 4)) |>
-  dplyr::mutate(prop_signature_ci_upper = round(
-    prop_signature_ci_upper, digits = 4)) |>
-  dplyr::mutate(
-    signature_aetiology = factor(
-      signature_aetiology, levels = signature_aetiology))
-
-signature_contribution_plot <- ggplot2::ggplot(
-  head(plot_data, 6), 
-  ggplot2::aes(
-    x = reorder(signature_aetiology, -prop_signature), 
-    y = prop_signature, 
-    fill = signature_aetiology)) +
-    ggplot2::geom_bar(stat = "identity") + 
-  ggplot2::geom_errorbar(
-    ggplot2::aes(ymin = prop_signature_ci_lower, 
-                 ymax = prop_signature_ci_upper), 
-    width = .3)+
-    ggplot2::scale_fill_manual(
-      values = head(pcgrr::color_palette$tier$values, NROW(plot_data))) +
-    ggplot2::theme_classic() +
-    ggplot2::xlab("") +
-    ggplot2::ylab("Relative contribution") +
-  ggplot2::theme(
-    legend.position = "bottom",
-    legend.title = ggplot2::element_blank(),
-    plot.margin = ggplot2::margin(0.5, 0.5, 0.5, 0.5, "cm"), 
-    axis.text.x = ggplot2::element_blank(),
-    axis.title.y = ggplot2::element_text(family = "Helvetica", size = 13),
-    axis.text.y = ggplot2::element_text(family = "Helvetica", size = 13),
-    legend.text = ggplot2::element_text(family = "Helvetica", size = 12))
-
-
-pltly_plot <- plotly::ggplotly(signature_contribution_plot)
-pltly_plot$x$layout$legend$title$text <- ""
+signature_contribution_plot <- 
+  pcgrr::plot_signature_contributions(
+    signature_contributions = msig_content$result$contributions
+  )
+
+
 bslib::card(
   height = "400px",
   bslib::card_header(
@@ -215,7 +181,8 @@ bslib::card(
       pcg_report$settings$sample_id)
   ),
   bslib::card_body(
-    pltly_plot
+    signature_contribution_plot[['plotly']]
+    #pltly_plot
   )
 )
 ```