From a8eda9b6763ee17bac966e8eb4fe625de82323ad Mon Sep 17 00:00:00 2001 From: Ines Scheller Date: Mon, 3 Apr 2023 19:41:28 +0200 Subject: [PATCH 1/3] fix merging with external cts for single sample --- R/mergeExternalData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mergeExternalData.R b/R/mergeExternalData.R index 37c2bf16..bbbd673a 100644 --- a/R/mergeExternalData.R +++ b/R/mergeExternalData.R @@ -100,8 +100,8 @@ mergeExternalData <- function(fds, countFiles, sampleIDs, annotation=NULL){ # merge psi5/psi3 data # extractExtData <- function(fds, countFun, type, ov, extData, extName){ - ctsOri <- as.matrix(countFun(fds, type=type)[from(ov),]) - ctsExt <- as.matrix(mcols(extData[[extName]])[to(ov),]) + ctsOri <- as.matrix(countFun(fds, type=type)[from(ov),,drop=FALSE]) + ctsExt <- as.matrix(mcols(extData[[extName]])[to(ov),,drop=FALSE]) ans <- cbind(ctsOri, ctsExt) mode(ans) <- "integer" ans From 191b81ebc394659aa1f43dc1ae95d63111d790a3 Mon Sep 17 00:00:00 2001 From: Ines Scheller Date: Mon, 3 Apr 2023 19:42:01 +0200 Subject: [PATCH 2/3] remove guide lines from volcano plot --- R/plotMethods.R | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/R/plotMethods.R b/R/plotMethods.R index 6f7a9a22..cc38e12c 100644 --- a/R/plotMethods.R +++ b/R/plotMethods.R @@ -337,25 +337,6 @@ plotVolcano.FRASER <- function(object, sampleID, theme(legend.position="none") + scale_color_manual(values=c("gray40", "firebrick")) - if(!is.na(deltaPsiCutoff)){ - g <- g + - geom_vline(xintercept=c(-deltaPsiCutoff, deltaPsiCutoff), - color="firebrick", linetype=2) - } - - if(!is.na(padjCutoff)){ - if(dt[padj <= padjCutoff, .N] > 0){ - padj_line <- min(dt[padj <= padjCutoff, -log10(pval)]) - padj_line <- min(dt[padj <= padjCutoff, -log10(pval)]) - } - if(!"padj_line" %in% ls() || padj_line > 10 || is.na(padj_line)){ - padj_line <- 6 - } - g <- g + - geom_hline(yintercept=padj_line, color="firebrick", linetype=4) - } - - if(isFALSE(basePlot)){ g <- g + xlab(paste("delta", ggplotLabelPsi(type, asCharacter=TRUE)[[1]])) + From eb51f7f47d9eba0e3fd25d669d7986a393584b4e Mon Sep 17 00:00:00 2001 From: Ines Scheller Date: Mon, 3 Apr 2023 19:42:45 +0200 Subject: [PATCH 3/3] correct gene level aberrant coloring for plots --- R/AllGenerics.R | 9 +++++++-- R/getNSetterFuns.R | 26 +++++++++++++++++++------- man/results.Rd | 4 ++-- 3 files changed, 28 insertions(+), 11 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 05eb80d1..f468a1df 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -788,7 +788,8 @@ FRASER.results <- function(object, sampleIDs, fdrCutoff, deltaPsiVals <- deltaPsiValue(tmp_x, type) rho <- rho(tmp_x, type) aberrant <- aberrant.FRASER(tmp_x, type=type, - padjCutoff=fdrCutoff, + padjCutoff=ifelse(isTRUE(aggregate), + NA, fdrCutoff), deltaPsiCutoff=dPsiCutoff, minCount=minCount, rhoCutoff=rhoCutoff, @@ -1080,6 +1081,10 @@ aberrant.FRASER <- function(object, type=fitMetrics(object), if(is.na(padjCutoff)){ padjCutoff <- 1 } + if(isTRUE(aggregate)){ + padjCutoffGene <- padjCutoff + padjCutoff <- 1 + } if(isTRUE(all)){ aberrantEvents <- matrix(TRUE, nrow=nrow(object), ncol=ncol(object)) @@ -1121,7 +1126,7 @@ aberrant.FRASER <- function(object, type=fitMetrics(object), if(isFALSE(all)){ aberrantEvents <- aberrantEvents & as.matrix( padj_gene[rownames(aberrantEvents),colnames(aberrantEvents)] - ) <= padjCutoff + ) <= padjCutoffGene } } diff --git a/R/getNSetterFuns.R b/R/getNSetterFuns.R index 00fb0055..9a29af0e 100644 --- a/R/getNSetterFuns.R +++ b/R/getNSetterFuns.R @@ -748,16 +748,18 @@ getPlottingDT <- function(fds, axis=c("row", "col"), type=currentType(fds), ) dt[, deltaPsi:=obsPsi - predPsi] - # add aberrant information to it - aberrantVec <- aberrant(fds, ..., padjVals=dt[,.(padj)], - dPsi=dt[,.(deltaPsi)], n=dt[,.(n)], - rhoVals=dt[,.(rho)], aggregate=FALSE) - dt[,aberrant:=aberrantVec] - # if requested return gene p values if(isTRUE(aggregate)){ - dt <- dt[!is.na(featureID)] + # get gene-level aberrant status + aberrantGeneLevel <- aberrant(fds[, idxcol], ..., aggregate=TRUE) + aberrantGeneLevel <- melt( + data.table(featureID=rownames(aberrantGeneLevel), + aberrantGeneLevel), + value.name="aberrant", id.vars="featureID", + variable.name="sampleID") + # split featureID into several rows if more than one + dt <- dt[!is.na(featureID)] dt[, dt_idx:=seq_len(.N)] dt_tmp <- dt[, splitGenes(featureID), by="dt_idx"] dt <- dt[dt_tmp$dt_idx,] @@ -780,6 +782,10 @@ getPlottingDT <- function(fds, axis=c("row", "col"), type=currentType(fds), pvalsGene <- merge(pvalsGene[[1]], pvalsGene[[2]], by=c("featureID", "sampleID")) + # merge with gene level aberrant status + pvalsGene <- merge(pvalsGene, aberrantGeneLevel, + by=c("featureID", "sampleID")) + # merge with gene pval matrix dt <- merge(dt, pvalsGene, by=c("featureID", "sampleID")) dt[,`:=`(pval=gene_pval, padj=gene_padj, @@ -789,6 +795,12 @@ getPlottingDT <- function(fds, axis=c("row", "col"), type=currentType(fds), dt <- dt[order(sampleID, featureID, type, -aberrant, padj, -abs(deltaPsi))][ !duplicated(data.table(sampleID, featureID, type))] + } else{ + # add aberrant information to it + aberrantVec <- aberrant(fds, ..., padjVals=dt[,.(padj)], + dPsi=dt[,.(deltaPsi)], n=dt[,.(n)], + rhoVals=dt[,.(rho)], aggregate=FALSE) + dt[,aberrant:=aberrantVec] } # return object diff --git a/man/results.Rd b/man/results.Rd index ceeb9fc8..d61c4c10 100644 --- a/man/results.Rd +++ b/man/results.Rd @@ -8,7 +8,7 @@ \S4method{results}{FraserDataSet}( object, sampleIDs = samples(object), - padjCutoff = 0.05, + padjCutoff = 0.1, deltaPsiCutoff = 0.1, rhoCutoff = NA, aggregate = FALSE, @@ -25,7 +25,7 @@ \S4method{aberrant}{FraserDataSet}( object, type = fitMetrics(object), - padjCutoff = 0.05, + padjCutoff = 0.1, deltaPsiCutoff = 0.1, minCount = 5, rhoCutoff = NA,