update sigDB

DESCRIPTION

@@ -57,5 +57,5 @@ Encoding: UTF-8
 LazyData: TRUE
 NeedsCompilation: no
 Packaged: 2016-04-08 02:06:05 UTC; anand
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
 SystemRequirements: GNU make

NAMESPACE

@@ -19,6 +19,7 @@ export(genesToBarcodes)
 export(genotypeMatrix)
 export(gisticBubblePlot)
 export(gisticChromPlot)
+export(gisticCompare)
 export(gisticOncoPlot)
 export(gtMarkers)
 export(icgcSimpleMutationToMAF)

R/coGisticChromPlotV.R

@@ -11,8 +11,7 @@
 #' @param g1Name the title of the left side
 #' @param g2Name the title of the right side
 #' @param type default 'Amp', c('Amp',"Del"), choose one to plot, only focal events are shown, 'Amp'
-#'   only shows the Amplification events, and 'Del' only shows the Deletion events. You can get both
-#'   types plots by running the function 2 times setting `type` to 'Amp' and 'Del' respectively.
+#'   only shows the Amplification events, and 'Del' only shows the Deletion events.
 #' @param markBands default TRUE, integer of length 1 or 2 or TRUE, mark cytoband names of the outer
 #'   side of the plot
 #' @param labelGenes if you want to label some genes you are interested along the chromosome, set it

R/compareSignatures.R

@@ -4,25 +4,19 @@
 #' @details SBS signature database was obtained from https://www.synapse.org/#!Synapse:syn11738319.7
 #'
 #' @param nmfRes results from \code{\link{extractSignatures}}
-#' @param sig_db can be \code{legacy} or \code{SBS}. Default \code{legacy}
+#' @param sig_db can be \code{legacy}, \code{SBS}, \code{SBS_v34}. Default \code{SBS_v34}
 #' @param verbose Default TRUE
 #' @return list containing cosine smilarities, aetiologies if available, and best match.
 #' @seealso \code{\link{trinucleotideMatrix}} \code{\link{extractSignatures}} \code{\link{plotSignatures}}
 #' @export
 #'
-compareSignatures = function(nmfRes, sig_db = "legacy", verbose = TRUE){
+compareSignatures = function(nmfRes, sig_db = "SBS_v34", verbose = TRUE){
 
-  sig_db = match.arg(arg = sig_db, choices = c("legacy", "SBS"))
+  sig_db = match.arg(arg = sig_db, choices = c("legacy", "SBS", "SBS_v34"))
 
-  if(sig_db == "legacy"){
-    sigs_db = readRDS(file = system.file('extdata', 'legacy_signatures.RDs', package = 'maftools'))
-    sigs = sigs_db$db
-    aetiology = sigs_db$aetiology
-  }else{
-    sigs_db = readRDS(file = system.file('extdata', 'SBS_signatures.RDs', package = 'maftools'))
-    sigs = sigs_db$db
-    aetiology = sigs_db$aetiology
-  }
+  sigs_db = readRDS(file = system.file('extdata', paste0(sig_db, '_signatures.RDs'), package = 'maftools'))
+  sigs = sigs_db$db
+  aetiology = sigs_db$aetiology
 
   w = nmfRes$signatures
   sigs = sigs[rownames(w),]

R/gisticChromPlot.R

@@ -32,7 +32,7 @@ gisticChromPlot = function(gistic = NULL, fdrCutOff = 0.1, markBands = NULL,
   g[,loc := sapply(strsplit(x = g$Wide_Peak_Limits, split = ':'), '[', 2)]
   g[,Start_Position := sapply(strsplit(x = g$loc, split = '-'), '[', 1)]
   g[,End_Position := sapply(strsplit(x = g$loc, split = '-'), '[', 2)]
-  g.lin = transformSegments(segmentedData = g[,.(Chromosome, Start_Position, End_Position, qvalues, Cytoband, Variant_Classification)])
+  g.lin = transformSegments(segmentedData = g[,.(Chromosome, Start_Position, End_Position, qvalues, Cytoband, Variant_Classification)], build = ref.build)
 
   if(is.null(color)){
     color = c('Amp' = 'red', 'Del' = 'blue')

R/gisticComapre.R

@@ -0,0 +1,108 @@
+#' compare two GISTIC objects
+#' @details Performs fisher test on 2x2 contingency table generated from two GISTIC objects
+#'
+#' @param g1 first \code{\link{GISTIC}} object
+#' @param g2 second \code{\link{GISTIC}} object
+#' @param g1Name optional name for first cohort
+#' @param g2Name optional name for second cohort
+#' @param minEvent Consider only cytobands with minimum this number of samples altered in at least one of the cohort for analysis. Helpful to ignore single mutated genes. Default 5.
+#' @param pseudoCount If TRUE, adds 1 to the contingency table with 0's to avoid `Inf` values in the estimated odds-ratio.
+#' @return result list
+#' @export
+#' @seealso \code{\link{forestPlot}}
+#' @seealso \code{\link{lollipopPlot2}}
+
+gisticCompare = function(g1, g2, g1Name = NULL, g2Name = NULL, minEvent = 5, pseudoCount = FALSE){
+
+  g1.gs <- getCytobandSummary(x = g1)
+  g2.gs <- getCytobandSummary(x = g2)
+
+
+  if(is.null(g1Name)){
+    g1Name = 'G1'
+  }
+
+  if(is.null(g2Name)){
+    g2Name = 'G2'
+  }
+
+  g1.sampleSize = as.numeric(g1@summary[ID %in% "Samples", summary])
+  g2.sampleSize = as.numeric(g2@summary[ID %in% "Samples", summary])
+
+  g1_nums = .getAmpDelCounts(g = g1)
+  g2_nums = .getAmpDelCounts(g = g2)
+
+  amptbl = merge(g1_nums[Variant_Classification %in% "Amp", .N , .(Cytoband)], g2_nums[Variant_Classification %in% "Amp", .N , .(Cytoband)], by = "Cytoband", all = TRUE)
+  colnames(amptbl) = c("Cytoband", "G1", "G2")
+  amptbl[is.na(amptbl)] = 0
+
+  deltbl = merge(g1_nums[Variant_Classification %in% "Del", .N , .(Cytoband)], g2_nums[Variant_Classification %in% "Del", .N , .(Cytoband)], by = "Cytoband", all = TRUE)
+  colnames(deltbl) = c("Cytoband", "G1", "G2")
+  deltbl[is.na(deltbl)] = 0
+
+  cnvtbl = data.table::rbindlist(l = list(Amp = amptbl, Del = deltbl), idcol = "CNV")
+  cnvtbl[,G1_wt := g1.sampleSize - G1]
+  cnvtbl[,G2_wt := g2.sampleSize - G2]
+
+  fisherTable = lapply(seq_len(nrow(cnvtbl)), function(i){
+    gene = cnvtbl[i, 1]
+
+    ft_mat = matrix(c(cnvtbl[i, G1], cnvtbl[i, G1_wt], cnvtbl[i, G2], cnvtbl[i, G2_wt]),
+                    byrow = TRUE, nrow = 2)
+
+    if(length(which(x = ft_mat == 0)) > 0){
+      if(pseudoCount){
+        ft_mat = ft_mat + 1
+      }
+    }
+
+    xf = fisher.test(ft_mat, conf.int = TRUE, conf.level = 0.95)
+
+    pval = xf$p.value
+    or = xf$estimate
+    ci.up = xf$conf.int[2]
+    ci.low = xf$conf.int[1]
+    tdat = data.table::data.table(pval = pval, or = or, ci.up = ci.up, ci.low = ci.low)
+    tdat
+  })
+  fisherTable = data.table::rbindlist(fisherTable, use.names = TRUE, fill = TRUE)
+  fisherTable = cbind(cnvtbl, fisherTable)
+  fisherTable = fisherTable[order(pval)]
+  fisherTable[,adjPval := p.adjust(p = pval, method = 'fdr')]
+  colnames(fisherTable)[3:6] = c(g1Name, g2Name, paste0(g1Name, "_wt"), paste0(g2Name, "_wt"))
+
+  fisherTable
+}
+
+
+.getAmpDelCounts = function(g){
+  gs <- getCytobandSummary(x = g)
+  amp_bands = gs[Variant_Classification %in% "Amp"]
+  del_bands = gs[Variant_Classification %in% "Del"]
+
+  amp_bands_samps = lapply(split(amp_bands, amp_bands$Cytoband), function(cb){
+
+    cb_tsbs = lapply(cb$Unique_Name, function(b){
+      b_samps = g@cnMatrix[b,]
+      names(b_samps[b_samps != ""])
+    })
+
+    cb_tsbs = unique(unlist(cb_tsbs, use.names = FALSE))
+    data.table::data.table(Cytoband = unique(cb$Cytoband), Tumor_Sample_Barcode = cb_tsbs)
+  })
+  amp_bands_samps_tbl = data.table::rbindlist(amp_bands_samps)
+
+  del_bands_samps = lapply(split(del_bands, del_bands$Cytoband), function(cb){
+
+    cb_tsbs = lapply(cb$Unique_Name, function(b){
+      b_samps = g@cnMatrix[b,]
+      names(b_samps[b_samps != ""])
+    })
+
+    cb_tsbs = unique(unlist(cb_tsbs, use.names = FALSE))
+    data.table::data.table(Cytoband = unique(cb$Cytoband), Tumor_Sample_Barcode = cb_tsbs)
+  })
+  del_bands_samps_tbl = data.table::rbindlist(del_bands_samps)
+
+  data.table::rbindlist(list(Amp = amp_bands_samps_tbl, Del= del_bands_samps_tbl), idcol = "Variant_Classification")
+}

R/plotSignatures.R

@@ -8,19 +8,19 @@
 #' @param color colors for each Ti/Tv conversion class. Default NULL
 #' @param patient_order User defined ordering of samples. Default NULL.
 #' @param title_size size of title. Default 1.3
-#' @param axis_lwd axis width. Default 2.
+#' @param axis_lwd axis width. Default 1.
 #' @param font_size font size. Default 0.6
 #' @param show_title If TRUE compares signatures to COSMIC signatures and prints them as title
-#' @param sig_db Only applicable if show_title is TRUE. Can be \code{legacy} or \code{SBS}. Default \code{legacy}
+#' @param sig_db Only applicable if show_title is TRUE. can be \code{legacy}, \code{SBS}, \code{SBS_v34}. Default \code{SBS_v34}
 #' @param show_barcodes Default FALSE
-#' @param yaxisLim Default 0.3. If NA autoscales.
+#' @param yaxisLim Default NA.
 #' @param ... further plot options passed to \code{\link{barplot}}
 #' @return Nothing
 #' @seealso \code{\link{trinucleotideMatrix}} \code{\link{plotSignatures}}
 #' @export
 #'
 plotSignatures = function(nmfRes = NULL, contributions = FALSE, absolute = FALSE, color = NULL, patient_order = NULL,
-                          font_size = 0.6, show_title = TRUE, sig_db = "legacy", axis_lwd = 2, title_size = 0.9, show_barcodes = FALSE, yaxisLim = 0.3, ...){
+                          font_size = 0.6, show_title = TRUE, sig_db = "SBS_v34", axis_lwd = 1, title_size = 0.9, show_barcodes = FALSE, yaxisLim = NA, ...){
 
   conv.mat.nmf.signatures = nmfRes$signatures
   if(absolute){
@@ -71,9 +71,7 @@ plotSignatures = function(nmfRes = NULL, contributions = FALSE, absolute = FALSE
              cex = 1.2, pt.cex = 1.5, horiz = TRUE)
     }
   }else{
-    if(show_title){
-      comp_res = compareSignatures(nmfRes = nmfRes, verbose = FALSE, sig_db = sig_db)
-    }
+    comp_res = compareSignatures(nmfRes = nmfRes, verbose = FALSE, sig_db = sig_db)
 
     plotData = as.data.frame(t(conv.mat.nmf.signatures))
     nsigs = nrow(plotData)

inst/NEWS.md

@@ -7,6 +7,10 @@
 ## ENHANCEMENTS
 - Better sorting of oncoplot with `collapsePathway`
 - Changed default background for oncoplot from `gray` to `#ecf0f1`
+- Changed default signature database to SBS_v3.4 (from legacy)
+
+## NEW FUNCTIONS
+- `gisticCompare()` for comparing two GISTIC objects
 
 # CHANGES IN VERSION 2.18.0
 (Bioconductor release branch)