IHWpaper 1.14.0
library("ggplot2")
library("grid")
library("dplyr")
library("cowplot")
library("IHWpaper")
Some general preliminary work, define factors, colours, which methods should we consider conservative, which anticonservative.
methods_pretty <- c("BH", "Clfdr", "Greedy Indep. Filt.", "IHW", "IHW naive", "FDRreg", "LSL GBH", "SBH", "TST GBH")
colors <- scales::hue_pal(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,direction = 1)(10)
conservative_methods <- c("BH", "Clfdr", "IHW", "FDRreg", "LSL GBH")
conservative_idx <- match(conservative_methods, methods_pretty)
anticonservative_methods <- c("Greedy Indep. Filt.", "IHW naive", "SBH", "TST GBH")
anticonservative_idx <- match(anticonservative_methods, methods_pretty)
null_grb_file <- system.file("simulation_benchmarks/result_files",
"ihw_null_simulation_benchmark_grb.Rds", package = "IHWpaper")
null_e3_file <- system.file("simulation_benchmarks/result_files",
"ihw_null_simulation_benchmark_E3.Rds", package = "IHWpaper")
null_file <- system.file("simulation_benchmarks/result_files",
"ihw_null_simulation_benchmark.Rds", package = "IHWpaper")
null_df <- rbind(readRDS(null_grb_file),
readRDS(null_e3_file),
readRDS(null_file)) %>%
filter(fdr_method != "IHW") %>% # just show IHW with E1-E3
mutate(fdr_method = ifelse(fdr_method=="IHW E3", "IHW", fdr_method),
fdr_method = sapply(strsplit(fdr_method," 20"), "[",1),
fdr_method = factor(fdr_method, levels= methods_pretty))
panel_a_df <- filter(null_df, fdr_method %in% anticonservative_methods)
last_vals_a <- group_by(panel_a_df, fdr_method) %>% summarize(last_vals = max(FDR)) %>%
mutate(last_vals = last_vals + c(0, 0,0.05, -0.03),
label = fdr_method,
colour = colors[anticonservative_idx])
panel_a <- ggplot(panel_a_df, aes(x=alpha, y=FDR, col=fdr_method)) +
geom_line(size=1.2) +
geom_abline(linetype="dashed") +
xlab(expression(bold(paste("Nominal ",alpha)))) +
scale_x_continuous(limits= c(0.01,0.1), breaks=seq(0.01,0.09,length=5)) +
ylim(0,0.9) +
theme(plot.margin = unit(c(3, 7.5, .2, .2), "lines"))+
scale_color_manual(values=colors[anticonservative_idx])+
theme(axis.title = element_text(face="bold") )
panel_a <- pretty_legend(panel_a, last_vals_a, 0.102)
panel_a
panel_b_df <- filter(null_df, fdr_method %in% conservative_methods)
last_vals_b <- group_by(panel_b_df, fdr_method) %>% summarize(last_vals = max(FDR)) %>%
mutate(last_vals = last_vals + c(0.005,0.005,-0.005, 0 ,-0.005 ),
label = fdr_method,
colour = colors[conservative_idx])
panel_b <- ggplot(panel_b_df, aes(x=alpha, y=FDR, col=fdr_method)) +
geom_abline(linetype="dashed") +
geom_line(size=1.2) +
xlab(expression(bold(paste("Nominal ",alpha)))) +
theme(plot.margin = unit(c(3, 7.5, .2, .2), "lines"))+
scale_color_manual(values=colors[conservative_idx])+
theme(axis.title = element_text(face="bold") )
panel_b <- pretty_legend(panel_b, last_vals_b, 0.102 )
panel_b
panel_ab <- plot_grid(panel_a, panel_b, labels=c("a)","b)"), vjust=4.5)
panel_ab <- ggdraw(panel_ab) +
geom_rect(aes(xmin=0,xmax=1,ymin=0,ymax=0.95),
color="black",alpha=0.0) +
draw_label("Nulls only", x = 1, y = 1,
vjust = 1, hjust = 1, size = 15, fontface = 'bold') +
theme(plot.margin=unit(c(.2,.2,.2,.2),"cm"))
panel_ab
#ggsave(panel_ab, "null_all.pdf",width=11,height=5.5)
effsize_grb_file <- system.file("simulation_benchmarks/result_files",
"ihw_du_ttest_inform_simulation_benchmark_grb.Rds", package = "IHWpaper")
effsize_e3_file <- system.file("simulation_benchmarks/result_files",
"ihw_du_ttest_inform_simulation_benchmark_E3.Rds", package = "IHWpaper")
effsize_file <- system.file("simulation_benchmarks/result_files",
"ihw_du_ttest_inform_simulation_benchmark.Rds", package = "IHWpaper")
effsize_df <- rbind(readRDS(effsize_grb_file),
readRDS(effsize_file),
readRDS(effsize_e3_file)) %>%
filter(fdr_method != "IHW") %>% # just show IHW with E1-E3
mutate(fdr_method = ifelse(fdr_method=="IHW E3", "IHW", fdr_method),
fdr_method = sapply(strsplit(fdr_method," 20"), "[",1),
fdr_method = factor(fdr_method, levels= methods_pretty))
panel_c_df <- filter(effsize_df, fdr_method %in% conservative_methods)
last_vals_c <- group_by(panel_c_df, fdr_method) %>% summarize(last_vals = FDR[which.max(eff_size)]) %>%
mutate(last_vals = last_vals + c(0,0.005,-0.005, 0 ,-0.01 ),
label = fdr_method,
colour = colors[conservative_idx])
panel_c <- ggplot(panel_c_df, aes(x=eff_size, y=FDR, col=fdr_method)) +
geom_hline(yintercept=0.1, linetype="dashed") +
geom_line(size=1.2) +
xlab("Effect size") +
theme(plot.margin = unit(c(3, 7.5, .2, .2), "lines"))+
scale_color_manual(values=colors[conservative_idx])+
theme(axis.title = element_text(face="bold") )
panel_c <- pretty_legend(panel_c, last_vals_c, 2.52 )
panel_c
panel_d_df <- filter(effsize_df, fdr_method %in% conservative_methods)
last_vals_d <- group_by(panel_d_df, fdr_method) %>% summarize(last_vals = power[which.max(eff_size)]) %>%
mutate(last_vals = last_vals + c(0,-0.015,-0.035, 0.035 ,+0.005 ),
label = fdr_method,
colour = colors[conservative_idx])
panel_d <- ggplot(panel_c_df, aes(x=eff_size, y=power, col=fdr_method)) +
geom_line(size=1.2) +
xlab("Effect size") +
ylab("Power")+
theme(plot.margin = unit(c(3, 7.5, .2, .2), "lines"))+
scale_color_manual(values=colors[conservative_idx])+
theme(axis.title = element_text(face="bold") )
panel_d <- pretty_legend(panel_d, last_vals_d, 2.52 )
panel_d