1 | datasetMerging(esets, method = c("union", "intersect"), standardization = c("quantile", "robust.scaling", "scaling", "none"), nthread = 1)
|
esets |
|
method |
|
standardization |
|
nthread |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function (esets, method = c("union", "intersect"), standardization = c("quantile",
"robust.scaling", "scaling", "none"), nthread = 1)
{
require(Biobase)
require(genefu)
if (nthread > 1) {
require(parallel)
}
method <- match.arg(method)
standardization <- match.arg(standardization)
ugid <- lapply(esets, function(x) {
return(Biobase::featureData(x)@data)
})
ugid <- do.call(rbind, ugid)
ugid <- ugid[!is.na(ugid[, "ENTREZID"]) & !duplicated(as.character(ugid[,
"ENTREZID"])), , drop = FALSE]
rownames(ugid) <- gsub(sprintf("(%s).", paste(names(esets),
collapse = "|")), "", rownames(ugid))
switch(method, union = {
feature.merged <- ugid
}, intersect = {
feature.merged <- lapply(esets, function(x) {
return(as.character(Biobase::featureData(x)@data[,
"ENTREZID"]))
})
feature.merged <- table(unlist(feature.merged))
feature.merged <- names(feature.merged)[feature.merged ==
length(esets)]
feature.merged <- ugid[match(feature.merged, as.character(ugid[,
"ENTREZID"])), , drop = FALSE]
}, {
stop("Unknown method")
})
exprs.merged <- lapply(esets, function(x, y) {
ee <- Biobase::exprs(x)
eem <- matrix(NA, nrow = length(y), ncol = ncol(ee),
dimnames = list(y, colnames(ee)))
eem[rownames(ee), colnames(ee)] <- ee
return(eem)
}, y = rownames(feature.merged))
exprs.merged <- do.call(cbind, exprs.merged)
ucid <- lapply(esets, function(x) {
return(colnames(phenoData(x)@data))
})
ucid <- table(unlist(ucid))
ucid <- names(ucid)[ucid == length(esets)]
clinicinfo.merged <- lapply(esets, function(x, y) {
ee <- Biobase::pData(x)[, y, drop = FALSE]
}, y = ucid)
clinicinfo.merged <- do.call(rbind, clinicinfo.merged)
rownames(clinicinfo.merged) <- gsub(sprintf("(%s).", paste(names(esets),
collapse = "|")), "", rownames(clinicinfo.merged))
eset.merged <- ExpressionSet(assayData = exprs.merged, phenoData = AnnotatedDataFrame(data = clinicinfo.merged),
featureData = AnnotatedDataFrame(data = feature.merged))
experimentData(eset.merged)@preprocessing <- list(normalization = "mixed",
package = "unspecified", version = "0")
annotation(eset.merged) <- "mixed"
switch(standardization, none = {
}, quantile = {
require(limma)
require(genefu)
ee <- exprs(eset.merged)
splitix <- parallel::splitIndices(nx = ncol(ee), ncl = nthread)
mcres <- parallel::mclapply(splitix, function(x, data) {
res <- apply(data[, x, drop = FALSE], 2, function(dx) {
return((genefu::rescale(dx, q = 0.05, na.rm = TRUE) -
0.5) * 2)
})
return(res)
}, data = ee, mc.cores = nthread)
ee <- do.call(cbind, mcres)
ee <- limma::normalizeBetweenArrays(object = ee, method = "quantile")
exprs(eset.merged) <- ee
}, robust.scling = {
require(genefu)
ee <- exprs(eset.merged)
splitix <- parallel::splitIndices(nx = ncol(ee), ncl = nthread)
mcres <- parallel::mclapply(splitix, function(x, data) {
res <- apply(data[, x, drop = FALSE], 2, function(dx) {
return((genefu::rescale(dx, q = 0.05, na.rm = TRUE) -
0.5) * 2)
})
return(res)
}, data = ee, mc.cores = nthread)
ee <- do.call(cbind, mcres)
exprs(eset.merged) <- ee
}, scaling = {
ee <- exprs(eset.merged)
splitix <- parallel::splitIndices(nx = ncol(ee), ncl = nthread)
mcres <- parallel::mclapply(splitix, function(x, data) {
return(apply(data[, x, drop = FALSE], 2, scale))
}, data = ee, mc.cores = nthread)
ee <- do.call(cbind, mcres)
exprs(eset.merged) <- ee
}, {
stop("Unknown data standardization method")
})
return(eset.merged)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.