bin_fragility: bin_fragility

Usage Arguments Examples

View source: R/bin_fragility.R

Usage

1
bin_fragility(alloutputs, lowindx, top_pm, alpha = 0.05, legend = FALSE, lgndcol = 2, yrange = NULL, pvtitle = NULL, savepvfile, pvpicdim)

Arguments

alloutputs
lowindx
top_pm
alpha
legend
lgndcol
yrange
pvtitle
savepvfile
pvpicdim

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
##---- 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 (alloutputs, lowindx, top_pm, alpha = 0.05, legend = FALSE, 
    lgndcol = 2, yrange = NULL, pvtitle = NULL, savepvfile, pvpicdim) 
{
    results <- alloutputs$alldist
    selname0 <- alloutputs$selname
    if (top_pm > length(selname0)) {
        stop("top_pm should be smaller than the number of observations.")
    }
    df <- as.data.frame(results$pvdist)
    N <- length(unique(df$dif))
    df$dif <- factor(df$dif, levels = as.character(0:(N - 1)))
    selname <- selname0[1:top_pm]
    if (top_pm < length(selname0)) {
        tt <- split(df, df$dif)
        ss <- lapply(tt, function(x) {
            return(x[1:top_pm, ])
        })
        df <- do.call("rbind", ss)
    }
    temp <- matrix(as.numeric(as.character(df$rep)), N, top_pm, 
        byrow = T)
    dat <- temp[1:lowindx, ]
    df <- data.frame(fragility = integer(top_pm), variable = character(top_pm), 
        stringsAsFactors = FALSE)
    df$fragility <- colSums(dat > -log10(alpha))
    df$variable <- selname
    df <- df[order(-df$fragility), ]
    df$variable <- factor(selname, levels = selname)
    df$group <- factor(df$fragility, levels = sort(unique(df$fragility), 
        decreasing = T))
    p <- ggplot(data = df, aes(x = variable, y = fragility, fill = group)) + 
        geom_bar(stat = "identity")
    if (is.null(yrange)) {
        y_range <- range(0, ceiling(max(df$fragility)))
    }
    else {
        y_range <- yrange
    }
    p <- ggplot(data = df, aes(x = variable, y = fragility, fill = variable)) + 
        geom_bar(stat = "identity") + scale_fill_manual(aes(labels = variable), 
        values = ggplot_build(p)$data[[1]]$fill, drop = FALSE) + 
        ylab("Fragility Index") + xlab(paste("Top", top_pm, "significant hits with decreasing order", 
        sep = " ")) + ggtitle(pvtitle) + ylim(y_range) + theme_bw() + 
        theme(plot.title = element_text(size = 24, face = "bold")) + 
        theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), 
            axis.line = element_line(colour = "black"), panel.border = element_blank(), 
            panel.background = element_blank(), axis.line.x = element_line(color = "black", 
                size = 1), axis.line.y = element_line(color = "black", 
                size = 1), axis.text = element_text(size = 16, 
                face = "bold"), axis.title = element_text(size = 20, 
                face = "bold"))
    if (isFALSE(legend)) {
        p <- p + theme(legend.position = "none")
    }
    else {
        p <- p + guides(col = guide_legend(ncol = lgndcol)) + 
            theme(legend.title = element_text(size = 20), legend.text = element_text(size = 12))
    }
    ggsave(filename = savepvfile, plot = p, width = pvpicdim[1], 
        height = pvpicdim[2])
    return(list(p = p, df = df))
  }

LyonsZhang/ProgPerm documentation built on July 16, 2020, 12:45 a.m.