Pierre-Luc Germain authored on 20/04/2020 06:22:42
| ... | ... |
@@ -40,7 +40,14 @@ paste("Takes a SE object, passes it through the function `dea.method`, and",
|
| 40 | 40 |
|
| 41 | 41 |
agg <- eva <- lapply(f, FUN=function(x) NULL) |
| 42 | 42 |
eva$dea <- evaluateDEA |
| 43 |
- agg$dea <- aggregateDEAeval |
|
| 43 |
+ agg$dea <- function(res){
|
|
| 44 |
+ res <- defaultStepAggregation(res) |
|
| 45 |
+ lapply( res, FUN=function(x){
|
|
| 46 |
+ x$sva.method <- gsub("^sva\\.","",x$sva.method)
|
|
| 47 |
+ x$dea.method <- gsub("^dea\\.","",x$dea.method)
|
|
| 48 |
+ x |
|
| 49 |
+ }) |
|
| 50 |
+ } |
|
| 44 | 51 |
|
| 45 | 52 |
# default arguments |
| 46 | 53 |
def <- list(minCount=10, k=1) |
Pierre-Luc Germain authored on 16/04/2020 11:29:50
| 1 | 1 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,80 @@ |
| 1 |
+#' dea_pipeline |
|
| 2 |
+#' |
|
| 3 |
+#' The `PipelineDefinition` for bulk RNAseq differential expression analysis |
|
| 4 |
+#' (DEA). |
|
| 5 |
+#' |
|
| 6 |
+#' @return A `PipelineDefinition` object to be used with `runPipeline`. |
|
| 7 |
+#' |
|
| 8 |
+#' @export |
|
| 9 |
+#' @examples |
|
| 10 |
+#' pip <- dea_pipeline() |
|
| 11 |
+#' pip |
|
| 12 |
+dea_pipeline <- function(){
|
|
| 13 |
+ # description for each step |
|
| 14 |
+ desc <- list( |
|
| 15 |
+ filtering= |
|
| 16 |
+paste("Takes a SE object, passes it through the function `filt` (with param",
|
|
| 17 |
+" `minCount`), and outputs a filtered SE object."), |
|
| 18 |
+ sva= |
|
| 19 |
+paste("Takes a SE object, passes it through the function `sva.method`, and",
|
|
| 20 |
+ "returns a SE object."), |
|
| 21 |
+ dea= |
|
| 22 |
+paste("Takes a SE object, passes it through the function `dea.method`, and",
|
|
| 23 |
+ "returns a DEA data.frame.") |
|
| 24 |
+ ) |
|
| 25 |
+ |
|
| 26 |
+ # functions list |
|
| 27 |
+ f <- list( |
|
| 28 |
+ filtering=function(x, filt, minCount=10) get(filt)(x, minCount=minCount), |
|
| 29 |
+ sva=function(x, sva.method, k=1){
|
|
| 30 |
+ get(sva.method)(x, k=k) |
|
| 31 |
+ }, |
|
| 32 |
+ dea=function(x, dea.method){
|
|
| 33 |
+ mm <- pipeComp:::.getMM(x) |
|
| 34 |
+ x2 <- pipeComp:::.homogenizeDEA(get(dea.method)(x,mm)) |
|
| 35 |
+ metadata(x2)$truth <- metadata(x)$truth |
|
| 36 |
+ metadata(x2)$mm <- mm |
|
| 37 |
+ x2 |
|
| 38 |
+ } |
|
| 39 |
+ ) |
|
| 40 |
+ |
|
| 41 |
+ agg <- eva <- lapply(f, FUN=function(x) NULL) |
|
| 42 |
+ eva$dea <- evaluateDEA |
|
| 43 |
+ agg$dea <- aggregateDEAeval |
|
| 44 |
+ |
|
| 45 |
+ # default arguments |
|
| 46 |
+ def <- list(minCount=10, k=1) |
|
| 47 |
+ |
|
| 48 |
+ # initiation function |
|
| 49 |
+ initf <- function(x){
|
|
| 50 |
+ if(is.character(x) && length(x)==1) x <- readRDS(x) |
|
| 51 |
+ metadata(x)$truth <- rowData(x)[,c("expected.beta","isDE")]
|
|
| 52 |
+ cn <- grep("^SV[[:digit:]]+$", colnames(colData(x)), invert=TRUE)
|
|
| 53 |
+ colData(x) <- colData(x)[,cn,drop=FALSE] |
|
| 54 |
+ x |
|
| 55 |
+ } |
|
| 56 |
+ |
|
| 57 |
+ PipelineDefinition(functions=f, descriptions=desc, evaluation=eva, |
|
| 58 |
+ aggregation=agg, initiation=initf, |
|
| 59 |
+ defaultArguments=def, verbose=FALSE) |
|
| 60 |
+} |
|
| 61 |
+ |
|
| 62 |
+#' @importFrom S4Vectors DataFrame |
|
| 63 |
+.homogenizeDEA <- function(x, g=NULL){
|
|
| 64 |
+ colnames(x)[which(colnames(x) %in% c("FDR","padj","adj.P.Val"))] <- "FDR"
|
|
| 65 |
+ colnames(x)[which(colnames(x) %in% c("P.Value","pvalue","PValue"))] <- "PValue"
|
|
| 66 |
+ colnames(x)[which(colnames(x) %in% c("log2FoldChange","logFC"))] <- "logFC"
|
|
| 67 |
+ if(is.null(g)) g <- row.names(x) |
|
| 68 |
+ x <- x[g,c("logFC","PValue","FDR")]
|
|
| 69 |
+ row.names(x) <- g |
|
| 70 |
+ if(!is(x,"DataFrame")) x <- DataFrame(x) |
|
| 71 |
+ x |
|
| 72 |
+} |
|
| 73 |
+ |
|
| 74 |
+#' @importFrom stats model.matrix |
|
| 75 |
+.getMM <- function(se){
|
|
| 76 |
+ v <- c( grep("^SV[[:digit:]]+$", colnames(colData(se)), value=TRUE),
|
|
| 77 |
+ "condition" ) |
|
| 78 |
+ f <- as.formula(paste0("~",paste(v,collapse="+")))
|
|
| 79 |
+ model.matrix(f, data=as.data.frame(colData(se))) |
|
| 80 |
+} |