## ----include=FALSE------------------------------------------------------------ library(BiocStyle) ## ----------------------------------------------------------------------------- suppressPackageStartupMessages({ library(pipeComp) library(S4Vectors) }) evaluateDEA <- function(dea, truth=NULL, th=c(0.01,0.05,0.1)){ ## we make sure that the column names of `dea` are standard: dea <- pipeComp:::.homogenizeDEA(dea) ## within Pipecomp, the truth should be passed along with the `dea` object, so ## we retrieve it here: if(is.null(truth)) truth <- metadata(dea)$truth dea <- cbind(dea, truth[row.names(dea),]) ## we get rid of genes for which the truth is unknown: dea <- dea[!is.na(dea$expected.beta),] ## comparison of estimated and expected log2 folchanges: res <- c(logFC.pearson=cor(dea$logFC, dea$expected.beta, use = "pairwise"), logFC.spearman=cor(dea$logFC, dea$expected.beta, use = "pairwise", method="spearman"), logFC.mad=median(abs(dea$logFC-dea$expected.beta),na.rm=TRUE), ntested=sum(!is.na(dea$PValue) & !is.na(dea$FDR))) ## evaluation of singificance calls names(th) <- th res2 <- t(vapply( th, FUN.VALUE=vector(mode="numeric", length=6), FUN=function(x){ ## for each significance threshold, calculate the various metrics called=sum(dea$FDR