ssapbm:

Usage Arguments Examples

View source: R/ssapbm.R

Usage

1
ssapbm(data = NULL, pathways = NULL, ref = NULL, target = NULL, minp = 2, maxp = 9999, method = c("sumoftsq", "ht2", "GSEA", "GAGE", "GSA"), perm = T, sampling = c("sample.labels", "gene.labels"), B = 100, sample.size = NULL, steps = 10, fdr = NULL, thr = 0.05, dc = T, rep = F, cr = NULL)

Arguments

data
pathways
ref
target
minp
maxp
method
perm
sampling
B
sample.size
steps
fdr
thr
dc
rep
cr

Examples

  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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
##---- 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 (data = NULL, pathways = NULL, ref = NULL, target = NULL, 
    minp = 2, maxp = 9999, method = c("sumoftsq", "ht2", "GSEA", 
        "GAGE", "GSA"), perm = T, sampling = c("sample.labels", 
        "gene.labels"), B = 100, sample.size = NULL, steps = 10, 
    fdr = NULL, thr = 0.05, dc = T, rep = F, cr = NULL) 
{
    if (is.null(target)) {
        cls2 <- c(1:ncol(data))[-ref]
    }
    else {
        cls2 <- target
    }
    d <- .processdata(data, pathways)
    data <- d[[1]]
    pathways <- d[[2]]
    cls1 <- ref
    TP <- pvl <- fdr.tp <- NULL
    if (is.null(fdr)) {
        fdr <- TRUE
        fdr.method <- "BH"
    }
    else {
        fdr.method <- fdr
        fdr <- TRUE
    }
    print(fdr.method)
    if (method[1] == "sumoftsq") {
        TP <- p.squared.t.test(data, cls1, cls2, steps = B, sampling = sampling[1], 
            pathways = pathways)
        if (!is.null(sample.size)) {
            pvl <- subsampanalysis(data, cls1, cls2, pathways, 
                B = 100, steps, sample.size = sample.size, method = "sumoftsq", 
                sampling = sampling[1], rep = rep, rn = rownames(TP), 
                dc = dc, thr = thr)
        }
        if (fdr) {
            fdr.tp <- p.adjust(TP[, "pval"], method = fdr.method)
        }
    }
    if (method[1] == "ht2") {
        TP <- pval.htsq(data, cls1, cls2, pathways = pathways, 
            perm = perm, sampling = sampling[1], steps = B)
        TP <- cbind(TP[[1]], TP[[2]])
        colnames(TP) <- c("ht2", "pval")
        if (!is.null(sample.size)) {
            pvl <- subsampanalysis(data, cls1, cls2, pathways, 
                B = 100, steps, sample.size = sample.size, method = "sumoftsq", 
                sampling = sampling[1], rep = rep, rn = rownames(TP), 
                dc = dc, thr = thr)
        }
        if (fdr) {
            fdr.tp <- p.adjust(TP[, 2], method = fdr.method)
        }
    }
    if (method[1] == "GSEA") {
        clsn <- rep(0, length(cls1) + length(cls2))
        clsn[cls2] <- 1
        lp <- sapply(pathways, length)
        lp <- c(min(lp), max(lp))
        TP <- GSEAx(data, ref = clsn, pathways, reshuffling.type = sampling[1], 
            nperm = B, gs.size.threshold.min = lp[1], gs.size.threshold.max = lp[2])
        TP <- as.matrix(rbind(TP[[1]][, c("ES", "NOM p-val")], 
            TP[[2]][, c("ES", "NOM p-val")]))
        print(TP)
        tmp1 <- cbind(as.numeric(as.vector(TP[, 1])), as.numeric(as.vector(TP[, 
            2])))
        rownames(tmp1) <- rownames(TP)
        colnames(tmp1) <- colnames(TP)
        TP <- tmp1
        TP <- TP[names(pathways), ]
        colnames(TP) <- c("GS", "pval")
        if (!is.null(sample.size)) {
            pvl <- subsampanalysis(data, cls1, cls2, pathways, 
                B = 100, steps, sample.size = sample.size, method = "GSEA", 
                sampling = sampling[1], rep = rep, rn = rownames(TP), 
                dc = dc, thr = thr)
        }
        if (fdr) {
            fdr.tp <- p.adjust(TP[, "pval"], method = fdr.method)
        }
    }
    if (method[1] == "GAGE") {
        lp <- sapply(pathways, length)
        lp <- c(min(lp), max(lp))
        print(head(data))
        pvl1 <- gage(data, gsets = pathways, ref = cls1, samp = cls2, 
            compare = "unpaired", set.size = c(lp[1], lp[2]), 
            same.dir = FALSE)
        TP <- pvl1[[1]][, 2:4]
        colnames(TP) <- c("stat.mean", "pval", "fdr.tp")
        if (fdr) {
            fdr.tp <- p.adjust(TP[, "pval"], method = fdr.method)
        }
        if (!is.null(sample.size)) {
            pvl <- subsampanalysis(data, cls1, cls2, pathways, 
                B = 100, steps, sample.size = sample.size, method = "GAGE", 
                dc = dc, thr = thr)
        }
    }
    if (method[1] == "GSA") {
        clsn <- rep(1, length(cls1) + length(cls2))
        clsn[cls2] <- 2
        lp <- sapply(pathways, length)
        lp <- c(min(lp), max(lp))
        TP <- GSA(data, clsn, genenames = rownames(data), genesets = pathways, 
            resp.type = "Two class unpaired", nperms = B, minsize = lp[1], 
            maxsize = lp[2])
        TP <- cbind(TP$GSA.scores, TP$pvalues.lo, TP$pvalues.hi)
        rownames(TP) <- names(pathways)
        tx <- (apply(TP, 1, function(x) c(which.min(as.numeric(x[2:3])))))
        TP <- cbind(TP, tx)
        print(TP)
        TP <- t(apply(TP, 1, function(x) x[c(1, (x[4] + 1))]))
        colnames(TP) <- c("GSA_score", "pval")
        if (fdr) {
            fdr.tp <- p.adjust(TP[, "pval"], method = fdr.method)
        }
        if (!is.null(sample.size)) {
            pvl <- subsampanalysis(data, cls1, cls2, pathways, 
                B = 100, steps, sample.size = sample.size, method = "GSA", 
                dc = dc, thr = thr)
        }
    }
    dcoverall <- corpaths <- NULL
    if (!is.null(cr)) {
        crall <- avgcorpath(data, ref = c(cls1, cls2), pathways, 
            method = cr)
        crctrl <- avgcorpath(data, ref = c(cls1), pathways, method = cr)
        crtreat <- avgcorpath(data, ref = c(cls2), pathways, 
            method = cr)
        corpaths <- cbind(crall, crctrl, crtreat)
    }
    if (dc) {
        clsn <- rep(1, length(cls1) + length(cls2))
        clsn[cls2] <- 2
        dcoverall <- pcdetectioncall(data, ref = clsn, pathways = pathways, 
            fdr = fdr.method, thr = thr)
    }
    if (fdr) {
        qval <- fdr.tp
        sigpath <- names(which(qval <= thr))
        list(cbind(TP, qval), pvl, dcoverall = dcoverall, corpaths = corpaths, 
            thr = thr, pathways = names(pathways), sigpath = sigpath, 
            fdr = fdr.method)
    }
  }

shaileshtripathi/ssapbm documentation built on May 26, 2017, 7 a.m.