1+ library(ggplot2 )
2+ library(dplyr )
3+ library(grid )
4+ library(gridExtra )
5+
6+ load(file = " dataFiles/summ.RData"
7+ head(summ )
8+
9+ s2 <- summ %> %
10+ ungroup() %> %
11+ select(condition , method , ME.pos , RMSE.pos ) %> %
12+ filter(! method %in% c(" pcurve.evidence" " pcurve.hack" " pcurve.lack" " PET.rma" " PEESE.rma" " PETPEESE.rma"
13+
14+ # get experimental factors
15+ conditions <- s2 %> % filter(method == " reMA" > % select(1 : 6 )
16+
17+
18+ # ---------------------------------------------------------------------
19+ # pairwise dominance
20+
21+ # reshape results into a data set with binary comparisons
22+ # This probably could be made more elegant, but I couldn't figure out how.
23+
24+ n.methods <- length(unique(s2 $ method ))
25+ methods <- unique(s2 $ method )
26+
27+ res <- data.frame ()
28+ for (C in unique(s2 $ condition )) {
29+ print(C )
30+ for (i in 1 : n.methods ) {
31+ for (j in 1 : n.methods ) {
32+ if (i > j )
33+ res <- rbind(res , data.frame (
34+ condition = C ,
35+ method1 = methods [i ],
36+ method2 = methods [j ],
37+ ME.pos1 = as.numeric(s2 [s2 $ condition == C & s2 $ method == methods [i ], " ME.pos"
38+ ME.pos2 = as.numeric(s2 [s2 $ condition == C & s2 $ method == methods [j ], " ME.pos"
39+ RMSE.pos1 = as.numeric(s2 [s2 $ condition == C & s2 $ method == methods [i ], " RMSE.pos"
40+ RMSE.pos2 = as.numeric(s2 [s2 $ condition == C & s2 $ method == methods [j ], " RMSE.pos"
41+ ))
42+ }
43+ }
44+ }
45+
46+ save(res , file = " dataFiles/dominanceScore.RData"
47+ # load(file="dataFiles/dominanceScore.RData")
48+
49+ res2 <- res %> % na.omit()
50+
51+ # define points, winners and draws
52+
53+ res2 $ winner <- " "
54+ res2 $ draw1 <- " "
55+ res2 $ draw2 <- " "
56+
57+ winner1 <- (abs(res2 $ ME.pos1 ) < abs(res2 $ ME.pos2 )) & (res2 $ RMSE.pos1 < res2 $ RMSE.pos2 )
58+ res2 $ winner [winner1 ] <- as.character(res2 $ method1 [winner1 ])
59+
60+ winner2 <- (abs(res2 $ ME.pos1 ) > abs(res2 $ ME.pos2 )) & (res2 $ RMSE.pos1 > res2 $ RMSE.pos2 )
61+ res2 $ winner [winner2 ] <- as.character(res2 $ method2 [winner2 ])
62+
63+ draw <- ((abs(res2 $ ME.pos1 ) > abs(res2 $ ME.pos2 )) & (res2 $ RMSE.pos1 < res2 $ RMSE.pos2 )) | ((abs(res2 $ ME.pos1 ) < abs(res2 $ ME.pos2 )) & (res2 $ RMSE.pos1 > res2 $ RMSE.pos2 ))
64+ res2 $ draw1 [draw ] <- as.character(res2 $ method1 [draw ])
65+ res2 $ draw2 [draw ] <- as.character(res2 $ method2 [draw ])
66+
67+
68+ # # give 1 point for "draw"
69+ # scores <- res2 %>% group_by(condition) %>% summarise(
70+ # RE = sum(winner=="reMA")*2 + sum(draw1=="reMA") + sum(draw2=="reMA"),
71+ # TF = sum(winner=="TF")*2 + sum(draw1=="TF") + sum(draw2=="TF"),
72+ # PET = sum(winner=="PET.lm")*2 + sum(draw1=="PET.lm") + sum(draw2=="PET.lm"),
73+ # PEESE = sum(winner=="PEESE.lm")*2 + sum(draw1=="PEESE.lm") + sum(draw2=="PEESE.lm"),
74+ # PETPEESE = sum(winner=="PETPEESE.lm")*2 + sum(draw1=="PETPEESE.lm") + sum(draw2=="PETPEESE.lm"),
75+ # pcurve = sum(winner=="pcurve")*2 + sum(draw1=="pcurve") + sum(draw2=="pcurve"),
76+ # puniform = sum(winner=="puniform")*2 + sum(draw1=="puniform") + sum(draw2=="puniform"),
77+ # TPSM = sum(winner=="3PSM")*2 + sum(draw1=="3PSM") + sum(draw2=="3PSM")
78+ # )
79+
80+ scores <- res2 %> % group_by(condition ) %> % summarise(
81+ RE = sum(winner == " reMA" * 2 ,
82+ TF = sum(winner == " TF" * 2 ,
83+ PET = sum(winner == " PET.lm" * 2 ,
84+ PEESE = sum(winner == " PEESE.lm" * 2 ,
85+ PETPEESE = sum(winner == " PETPEESE.lm" * 2 ,
86+ pcurve = sum(winner == " pcurve" * 2 ,
87+ puniform = sum(winner == " puniform" * 2 ,
88+ TPSM = sum(winner == " 3PSM" * 2
89+ )
90+
91+ scores.long <- melt(scores , id.vars = " condition"
92+
93+ scores $ winner <- " "
94+ for (i in 1 : nrow(scores )) {
95+ scores $ winner [i ] <- paste0(colnames(scores )[which(scores [i , 2 : 9 ] == max(scores [i , 2 : 9 ])) + 1 ], collapse = " , "
96+ }
97+
98+ scores <- merge(scores , conditions , by = " condition"
99+ scores.long <- merge(scores.long , conditions , by = " condition"
100+
101+ scores $ winner <- factor (scores $ winner , levels = names(sort(table(scores $ winner ), decreasing = TRUE )))
102+
103+ sort(table(scores $ winner ), decreasing = TRUE )
104+
105+ ggplot(scores , aes(y = qrpEnv , x = factor (delta ), shape = factor (winner ))) + geom_point(size = 6 ) + facet_grid(selProp ~ k + tau )
106+
107+ # That looks ugly ...
108+ scores.long $ loop <- paste0(scores.long $ delta , " :" scores.long $ qrpEnv , " :" scores.long $ tau )
109+ ggplot(scores.long , aes(y = value , x = loop , color = factor (variable ), group = factor (variable ))) + geom_line() + facet_grid(k ~ selProp )
110+
111+ # ---------------------------------------------------------------------
112+ # strong (absolute) dominance
113+
114+ s2 <- summ %> %
115+ ungroup() %> %
116+ select(condition , k , delta , qrpEnv , selProp , tau , method , ME.pos , RMSE.pos ) %> %
117+ filter(! method %in% c(" pcurve.evidence" " pcurve.hack" " pcurve.lack" " PET.rma" " PEESE.rma" " PETPEESE.rma"
118+
119+ # which method is best in ME?
120+ ME.matrix <- dcast(s2 , condition ~ method , value.var = " ME.pos"
121+ ME.matrix $ ME.winner <- colnames(ME.matrix )[apply(ME.matrix , 1 , which.min )]
122+
123+ # which method is best in RMSE?
124+ RMSE.matrix <- dcast(s2 , condition ~ method , value.var = " RMSE.pos"
125+ RMSE.matrix $ RMSE.winner <- colnames(RMSE.matrix )[apply(RMSE.matrix , 1 , which.min )]
126+
127+ fullDominance <- cbind(ME.matrix [, c(" condition" " ME.winner" RMSE.winner = RMSE.matrix $ RMSE.winner )
128+ fullDominance $ winner <- " "
129+ fullDominance $ winner [fullDominance $ ME.winner == fullDominance $ RMSE.winner ] <- fullDominance $ ME.winner [fullDominance $ ME.winner == fullDominance $ RMSE.winner ]
130+
131+ sort(table(fullDominance $ winner [fullDominance $ winner != " " decreasing = TRUE )
132+
133+ s3 <- merge(fullDominance , conditions , by = " condition"
134+
135+
136+ ggplot(s3 %> % filter(winner != " " y = qrpEnv , x = factor (delta ), shape = factor (winner ))) + geom_point(size = 6 ) + facet_grid(selProp ~ k + tau )
137+
138+
139+ ggplot(s3 %> % filter(winner != " " y = qrpEnv , x = factor (delta ), shape = factor (winner ))) + geom_point(size = 6 ) + facet_grid(selProp ~ k + tau )
0 commit comments