├── .gitignore
├── DESCRIPTION
├── LICENSE
├── PET-PEESE test
├── input_data.csv
└── load.R
├── README.md
├── TIVA.R
├── TODO.md
├── demo-data
├── 855_t_tests.txt
├── Bem2011.txt
├── H0_100x5.txt
├── H0_hack_100x5.txt
├── H1_100x5.txt
├── IQ_grades.txt
├── JPSP-p-curve.txt
├── Shanks.txt
├── elderly_priming.txt
├── glucose.txt
├── moneypriming.txt
└── powerposing.txt
├── fasterParser.R
├── helpers.R
├── original code from others
├── Colada-37-p-curve-disclosure-table-for-Power-Posing.xlsx
├── Gervais_PowerCode_final.R
├── Roth-IQ.ods
├── Shanks Meta-analysis_data.xlsx
├── Simonsohn_p-curve-code.R
├── VadilloHardwickeShanks_effect_sizes edited.xlsx
├── VadilloHardwickeShanks_effect_sizes.xlsx
├── VadilloHardwickeShanks_pcurve_disclosure_table.xlsx
├── comparisonMoney.R
├── input_data.csv
├── oldParser.R
├── old_p_curve_get33.R
└── p-curve disclosure table.xlsx
├── p-checker.Rproj
├── p-curve.R
├── pancollapse.R
├── run.R
├── server.R
├── snippets
├── about.html
├── demo_syntax.txt
├── extended_manual.html
├── quick_start.html
├── responsibly.html
└── version_history.html
├── tests.R
├── tests
└── Dunlap paired t-tests.R
├── ui.R
└── www
├── accordion.css
├── busy.css
├── busy.js
├── demo-pics
└── powerposing.jpg
├── loading.css
├── p-checker-theme.css
├── pancollapse.css
├── pancollapse.js
├── preloader.gif
└── showstartmessage.js
/.gitignore:
--------------------------------------------------------------------------------
1 |
2 | # History & Project Files
3 | .Rhistory
4 | .Rapp.history
5 | .Rproj
6 | .RData
7 |
8 | # Sandbox directory
9 | /.sandbox
10 |
11 | # Example code in package build process
12 | *-Ex.R
13 | .Rproj.user
14 |
--------------------------------------------------------------------------------
/DESCRIPTION:
--------------------------------------------------------------------------------
1 | Title: R-index and p-Curve App
2 | Author: Felix Schönbrodt, with code from Uri Simonsohn & Moritz Heene
3 | AuthorUrl: http://www.nicebread.de
4 | License: GPL-3
5 | DisplayMode: Normal
6 | Type: Shiny
7 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 2, June 1991
3 |
4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., Journal of Experimental Psychology: General, 143 , 534–547, Figure 3B.
4 | #' @url http://www.p-curve.com/Supplement/full_pdt.xlsx
5 |
6 | # To replicate the results of the paper, deselect "Gracious rounding up" and deselect "Make p-curve robust to outliers".
7 |
8 | F(1,57)=7.25; p=0.0093
9 | t(39)=4.16; p=0.0002
10 | t(38)=2.67; p=0.0111
11 | F(1,77)=5.86; p=0.0178
12 | F(1,48)=4.12; p=0.0479
13 | F(1,27)=4.21; p=0.0500002
14 | t(30)=2.52; p=0.0173
15 | t(30)=2.5; p=0.0181
16 | F(1,31)=6.73; p=0.0143
17 | F(1,92)=4.45; p=0.0376
18 | F(1,32)=4.46; p=0.0426
19 | F(1,52)=5.08; p=0.0284
20 | t(20)=3.36; p=0.0031
21 | t(19)=3.79; p=0.0012
22 | F(1,72)=22.56; p=0.00001
23 | t(26)=4.98; p=0.00003543
24 | t(46)=2.07; p=0.0441
25 | F(1,63)=8.27; p=0.0055
26 | F(1,45)=7.62; p=0.0083
27 | t(9)=2.03; p=0.0729
28 | t(9)=1.69; p=0.1253
29 | F(1,55)=9.96; p=0.0026
30 | F(1,104)=5.04; p=0.0269
31 | F(1,44)=8.38; p=0.0059
32 | t(36)=2.35; p=0.0244
33 |
--------------------------------------------------------------------------------
/demo-data/Shanks.txt:
--------------------------------------------------------------------------------
1 | r(24) = .55; BS
2 | r(21) = .45; BS
3 | t(72) = 4.80; BS
4 | F(1, 40) = 5.00; BS
5 | F(1, 48) = 7.46; BS
6 | t(131) = 2.51; BS
7 | t(131) = 2.25; BS
8 | t(29) = 2.17; BS
9 | t(40) = 2.61; BS
10 | t(110) = 6.09; BS
11 | t(94) = 5.12; BS
12 | F(1, 87) = 3.82; BS
13 | F(1, 68) = 7.10; BS
14 | F(1, 71) = 4.83; BS
15 | F(1, 93) = 6.37; BS
16 | F(1, 94) = 4.57; BS
17 | F(1, 101) = 4.84; BS
18 | F(1, 101) = 4.31; BS
19 | F(1, 195) = 10.64; BS
20 | F(1, 58) = 7.88; BS
21 | F(1, 164) = 3.66; BS
22 | F(1, 106) = 6.26; BS
23 | F(1, 148) = 12.22; BS
24 | F(1, 144) = 4.27; BS
25 | F(1, 57) = 4.58; BS
26 | F(1, 74) = 5.58; BS
27 | F(1, 114) = 7.29; BS
28 | F(1, 52) = 4.74; BS
29 | F(1, 177) = 9.62; BS
30 | F(1, 98) = 4.75; BS
31 | F(1, 102) = 9.11; BS
32 | F(1, 210) = 4.43; BS
33 | F(1, 166) = 6.59; BS
34 | F(1, 105) = 8.54; BS
35 | F(1, 136) = 4.03; BS
36 | F(1,40) = 4.75; BS
37 | F(1,33) = 8.88; BS
38 | F(1, 87) = 9.99; BS
39 | F(1, 38) = 8.54; BS
40 | F(1, 64) = 8.61; BS
41 | t(112) = 1.96; BS
42 | t(119) = 3.42; BS
43 | t(44) = 1.85; BS
--------------------------------------------------------------------------------
/demo-data/elderly_priming.txt:
--------------------------------------------------------------------------------
1 | #' @title ELDERLY PRIMING
2 | #' @subtitle by D. Lakens
3 | #' @details p-curve analysis from Lakens, D. (2014). Professors are not elderly: Evaluating the evidential value of two social priming effects through p-curve analyses. Available at SSRN: http://ssrn.com/abstract=2381936 or http://dx.doi.org/10.2139/ssrn.2381936
4 | #' @url https://osf.io/3urp2/
5 |
6 | # Test statistics kindly provided by Daniel Lakens at https://osf.io/3urp2/
7 |
8 | A&D (2002) S1: F(1, 102) = 4.95; p < .03
9 | A&D (2002) S1: F(1, 102) = 4.29; p < .05
10 | A&D (2002) S2: F(1, 160) = 4.68; p < .05
11 | A&D (2002) S2: F(1, 160) = 6.07, p < .02
12 |
13 | BC&B (1996) S2a: t(28) = 2.86; p < .01
14 | BC&B (1996) S2b: t(28) = 2.16; p < .05
15 |
16 | CP&H (2006) S1: t(47) = 2.04; p = .05
17 | CP&H (2006) S2: F(1, 64) = 5.81; p = .02
18 |
19 | DAB&vK (2000) S1: F(1, 71) = 4.06; p < .05
20 | DAB&vK (2000) S2: F(1, 36) = 4.26; p < .05
21 |
22 | DS&L (2001) S1: F(1, 151) = 4.18; p =.05
23 | DS&L (2001) S2: F(1, 77) = 12.71; p < .001
24 | DS&L (2001) S3: F(1, 61) = 4.23; p < .05
25 |
26 | KY&D (2002) S1: t(58) = 2.46; p < .05
27 | KY&D (2002) S2: t(64) = 2.18; p < .05
28 |
29 | KW&G (2010) S2: t(29) = 2.08; p = .047
30 | KW&G (2010) S2: t(27) = 2.23; p = .04
31 |
32 | M (2006) S2: t(35) = 2.1; p < .05
33 |
--------------------------------------------------------------------------------
/demo-data/glucose.txt:
--------------------------------------------------------------------------------
1 | #' @title Glucose Model of Ego Depletion
2 | #' @subtitle by M. Vadillo et al.
3 | #' @details Data from Vadillo, M. A., Gold, N., & Osman, M. (2016). The Bitter Truth About Sugar and Willpower: The Limited Evidential Value of the Glucose Model of Ego Depletion. Psychological Science (online first). http://doi.org/10.1177/0956797616654911
4 | #' @url https://osf.io/438jx/
5 |
6 | # For disclosure table about in/exclusion of effect sizes, see the link.
7 | # Thanks to @mavadillo for sharing open data!
8 |
9 | t(15) = 2.469
10 | t(67) = 2.19
11 | t(151) = 2.24
12 | F(1,55) = 6.64
13 | z = 1.88; one-tailed
14 | F(1,177) = 5.63
15 | r(50) = .30
16 | F(1,100) = 6.08
17 | t(33) = 2.20
18 | r(14) = .62
19 | r(10) = .56; one-tailed
20 | r(21) = .45
21 | r(15) = .43; one-tailed
22 | F(1,57) = 5.04
23 | F(1,69) = 5.45
24 | t(16) = 3.13
25 | t(47) = 2.21
26 | F(1,24) = 8.42
27 | F(1,30) = 6.12
28 | F(1,32) = 4.06; crit=.06 # "significantly better"
29 | F(1,40) = 10.32
30 | F(1,36) = 7.28
31 | F(4,75) = 2.95
32 | t(78) = 2.10
33 | F(1,58) = 5.16
34 | F(1,139) = 5.28
35 | F(1,67) = 0.80
36 | F(1,68) = 1.12
37 | F(1,110) = 0.01
38 | t(68) = 0.05
39 | F(1,111) = 5.311
40 | F(1,83) = 2.05
41 | F(1,39) = 4.54
42 | F(1,28) = 5.02
43 | F(1,158) = 0.379
44 | t(49) = 2.129
45 | t(31) = 2.55
46 | t(32) = 3.12
--------------------------------------------------------------------------------
/demo-data/moneypriming.txt:
--------------------------------------------------------------------------------
1 | #' @title Glucose Model of Ego Depletion
2 | #' @subtitle by M. Vadillo et al.
3 | #' @details Vadillo, M. A., Hardwicke, T. E., & Shanks, D. R. (2016). Selection bias, vote counting, and money-priming effects: A comment on Rohrer, Pashler, and Harris (2015) and Vohs (2015). Journal of Experimental Psychology: General, 145(5), 655–663. http://doi.org/10.1037/xge0000157. Note : The results slightly differ from the paper, as these analyses are based on the p-curve disclosure table, which contains a slightly different ES selection than the meta-analyses reported in the paper.
4 | #' @url https://osf.io/4e3gy
5 |
6 | # For disclosure table about in/exclusion of effect sizes, see the link.
7 | # Thanks to @mavadillo for sharing open data!
8 |
9 | # Vohs et al. + Caruso et al.
10 | t(28) = 2.12
11 | t(166) = 2.81
12 | t(78) = 2.24
13 | F(1, 271) = 14.63
14 | F(1, 88) = 6.93
15 | F(2,49) = 3.73
16 | t(35) = 2.03
17 | t(37) = 2.06
18 | t(42) = 2.13
19 | F(2, 32) = 4.34
20 | t(38) = 2.13
21 | t(33) = 2.37
22 | F(2, 58) = 4.04
23 | Chi2(2) = 10.10
24 |
25 | # robustness
26 | F(1, 271) = 10.22
27 | t(33) = 2.30
28 |
29 |
30 | # Table 1 in Vohs et al.
31 |
32 | F (1,76) = 4.81
33 | F(1,49)=4.18
34 | F(1, 37)=6.63
35 | t(66) = 3.15
36 | t(88) = 2.99
37 | F(2, 308) = 4.08
38 | F(2, 84) = 10.02
39 | F(1, 86) = 4.86
40 | F(1, 80)=4.39
41 | F(1, 92)=5.49
42 |
43 |
44 | # replication studies: Rohrer et al. + ManyLabs 1
45 |
46 | t(82) = -0.03
47 | t(118) = 0.96
48 | t(82) = -0.67
49 | t(93) = 1.12
50 | t(94) = 0.06
51 | t(100) = -1.19
52 | t(88) = 0.04
53 | t(172) = 0.77
54 | t(111) = 0.67
55 | t(110) = -0.74
56 | t(275) = -1.35
57 | t(143) = -0.41
58 | t(92) = 2
59 | t(83) = 0.9
60 | t(997) = -1.02
61 | t(105) = 0.49
62 | t(120) = 0.2
63 | t(1324) = -0.51
64 | t(93) = 0.07
65 | t(100) = 0.15
66 | t(83) = 0.61
67 | t(160) = -1.37
68 | t(77) = 0.92
69 | t(167) = -0.77
70 | t(185) = -1.09
71 | t(85) = -1.22
72 | t(223) = 1.33
73 | t(78) = 0.94
74 | t(125) = -0.84
75 | t(140) = -0.17
76 | t(79) = 1.33
77 | t(105) = -0.29
78 | t(94) = -1
79 | t(101) = 0.87
80 | t(88) = 1.14
81 | t(85) = -0.88
82 | t(134) = -0.43
83 | t(418) = 0.58
84 | t(210) = 0.0
85 | t(189) = 1.70
86 | t(154) = -0.36
87 | t(114) = 0.76
88 |
--------------------------------------------------------------------------------
/demo-data/powerposing.txt:
--------------------------------------------------------------------------------
1 | #' @title POWER POSING p-curve
2 | #' @subtitle by J. P. Simmons & U. Simonsohn
3 | #' @details Data from Simmons, J. P. & Simonsohn, U. (2016). Power Posing: P-Curving the Evidence. Psychological Science, Forthcoming. Available at SSRN: http://ssrn.com/abstract=2791272 (see "Main p-curve results").
4 | #' @url http://datacolada.org/37
5 |
6 | # For disclosure table about in/exclusion of effect sizes, see blog post.
7 | # Thanks to @jpsimmon and @uri_sohn for sharing open data!
8 |
9 | Allen, Gervais, & Smith (2013): t(83)=2.24; one-tailed
10 | Allen, Gervais, & Smith (2013): t(83)=1.78; one-tailed
11 | Arnette & Pettijohn (2012): t(40)=3.28
12 | Bohns & Wiltermuth (2012), S1: t(83)=1.99
13 | Bohns & Wiltermuth (2012), S2: t(26)=2.23
14 | Brinol, Petty, & Wegener (2009): F(1,67)=9.91
15 | Carney, Cuddy, & Yap (2010), S1: chi2(1)=4.84
16 | Carney, Cuddy, & Yap (2010), S2: F(1,39)=4.29
17 | Cesario & McDonald (2013), S1: z=1.98
18 | Cesario & McDonald (2013), S2: z=1.91; crit=.06 # "Results indicated a clear, singular effect"
19 | Cuddy et al. (in press): F(1,60)=8.33
20 | Fischer et al. (2011), S2: t(34)=2.30
21 | Huang et al. (2011), S1: F(1,73)=7.08
22 | Huang et al. (2011), S2: chi2(1)=5.28
23 | Huang et al. (2011), S3: F(1,53)=5.41
24 | Lee & Schnall (2014), S2: F(1,39)=5.08
25 | Michalak et al. (2014): F(1,28)=3.78; one-tailed
26 | Nair et al. (2014): F(1,70)=6.09
27 | Park et al. (2013), S3: F(1,101)=4.02
28 | Park et al. (2013), S4: F(1,79)=4.24
29 | Riskind (1984), S2: F(1,37)=5.13
30 | Riskind (1984), S2: F(1,37)=3.20
31 | Riskind (1984), S3: F(1,18)=4.94
32 | Riskind & Gotay (1982), S1: F(1,16)=7.73
33 | Riskind & Gotay (1982), S2: t(18)=2.03; one-tailed
34 | Strelan, Weick, & Vasiljevic (2014), S3: t(79)=2.21
35 | Welker et al. (2013), S1: F(1,87)=1.26
36 | Welker et al. (2013), S2: F(1,80)=9.44
37 | Yap et al. (2013), S1: chi2(1)=13.0
38 | Yap et al. (2013), S2: F(1,29)=4.04; crit=.06 # "as predicted --> p = .05"
39 | Yap et al. (2013), S3: F(1,66)=4.12
40 |
--------------------------------------------------------------------------------
/helpers.R:
--------------------------------------------------------------------------------
1 | # ---------------------------------------------------------------------
2 | # Helper functions
3 |
4 | COLORS <- list(
5 | BLUE = "#3399f3",
6 | GREEN = "#0BBC2B"
7 | )
8 | # Helper: Transform correlation to Fisher's Z
9 | r2Z <- function(r) {return(0.5 * log((1 + r)/(1 - r)))}
10 |
11 | # Helper: Recode Fisher's z to correlation
12 | Z2r <- function(Z) {return((exp(2*Z)-1)/(exp(2*Z)+1))}
13 |
14 |
15 | # simple wrapper: formats a number in f.2 format
16 | f2 <- function(x, digits=2, prepoint=0, skipZero=FALSE) {
17 |
18 | if (skipZero == TRUE) {zero <- "."} else {zero <- "0."}
19 |
20 | if (length(dim(x)) == 2) {
21 | apply(x, 2, function(x2) {gsub("0.", zero, sprintf(paste("%",prepoint,".",digits,"f",sep=""), x2) , fixed=TRUE)})
22 | } else {
23 | gsub("0.", zero, sprintf(paste("%",prepoint,".",digits,"f",sep=""), x) , fixed=TRUE)
24 | }
25 | }
26 |
27 |
28 | # Given a column: if numeric, convert to formatted string; otherwise, return unchanged
29 | format_num <- function(col, digits) {if (is.numeric(col)) {sprintf(paste0('%1.', digits, 'f'), col)} else {col}}
30 | format_num2 <- function(col) {if (is.numeric(col)) {sprintf(paste0('%1.0f'), col)} else {col}}
31 |
32 |
33 | # nicely formats a p-value
34 | p0 <- function(x, digits=3) {
35 | if (is.na(x)) return("NA")
36 | if (x >= .1^digits) return(paste0("p = ", f2(x, digits, skipZero=TRUE)))
37 | if (x < .1^digits) return(paste0("p < ", f2(.1^digits, digits, skipZero=TRUE)))
38 | }
39 | p <- Vectorize(p0)
40 |
41 |
42 |
43 | # Get the number of decimal places
44 | # Taken from http://stackoverflow.com/questions/5173692/how-to-return-number-of-decimal-places-in-r
45 | decimalplaces <- function(x) {
46 | if (is.na(x)) return(0)
47 | if ((x %% 1) != 0) {nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed=TRUE)[[1]][[2]])}
48 | else {return(0)}
49 | }
50 |
51 | decplaces <- function(x) {nchar(str_extract(x, "\\.\\d*$"))-1}
52 |
53 | clamp <- function(x, MIN=.00001, MAX=.99999) {x[xMAX] <- MAX; x}
54 |
55 | str_match_empty <- function(..., position=2) {
56 | res <- str_match(...)[position]
57 | if (is.na(res)) res <- ""
58 | res
59 | }
60 |
61 | logScaleHack <- function(v){
62 | isNotPowOf10 <- (log(v, 10) %% 1) != 0
63 | v[isNotPowOf10] <- v[isNotPowOf10] + 0.1
64 | v
65 | }
66 |
67 | logScaleTicks <- function(v){
68 | rv <- range(v)
69 | rv <- c(max(1,rv[1]), max(1,rv[2]))
70 | exponent <- floor(log(rv, 10))
71 | mult <- round(rv / (10^(exponent)))
72 | diff <- exponent[2] - exponent[1]
73 | if( diff == 0 ){
74 | res <- (mult[1]:mult[2])*10^exponent[1]
75 | } else if( diff == 1){
76 | res <- c((mult[1]:9)*10^exponent[1], (1:mult[2])*10^exponent[2])
77 | } else {
78 | res <- c(
79 | (mult[1]:9)*10^exponent[1],
80 | rep(1:9, diff-1) * 10^(rep((exponent[1]+1):(exponent[2]-1), each=9)),
81 | (1:mult[2])*10^exponent[2]
82 | )
83 | }
84 | logScaleHack(res)
85 | }
86 |
87 | logScaleLimits <- function(v)
88 | {
89 | rv <- range(v) * c(0.9, 1.1)
90 | rv <- c(max(1,rv[1]), max(1,rv[2]))
91 |
92 | exponents <- floor(log(rv, 10))
93 | results <- rv / (10^exponents)
94 | results <- c(floor(results[1]), ceiling(results[2]))
95 |
96 | diff <- abs(exponents[2] - exponents[1])
97 | if(diff == 0){
98 | results <- c(1,10)
99 | } else if(diff == 1){
100 | if(results[1] == 1){
101 | results[2] <- 10
102 | } else {
103 | if(results[1] > 10 - results[2]){
104 | results[2] <- 10
105 | } else {
106 | results[1] <- 1
107 | }
108 | }
109 | }
110 |
111 | results * (10^exponents)
112 | }
113 |
114 |
115 |
116 | # ---------------------------------------------------------------------
117 | # Meta-Regression helper functions
118 |
119 | tidyRMA <- function(RMA) {
120 | res <- data.frame(
121 | term = if(length(RMA$b)==1) {"b0"} else {c("b0", "b1")},
122 | estimate = as.vector(RMA$b),
123 | std.error = RMA$se,
124 | statistic = RMA$zval,
125 | p.value = RMA$pval,
126 | conf.low = RMA$ci.lb,
127 | conf.high = RMA$ci.ub
128 | )
129 | rownames(res) <- NULL
130 | return(res)
131 | }
132 |
133 | tidyLM <- function(...) {
134 | res <- tidy(..., conf.int=TRUE)
135 | res$term[res$term == "(Intercept)"] <- "b0"
136 | res$term[res$term == "d.se"] <- "b1"
137 | res$term[res$term == "d.var"] <- "b1"
138 | return(res)
139 | }
140 |
141 | # this function combines tidyRMA and tidyLM
142 | tidyMR <- function(x) {
143 | if (class(x)[1] == "lm") {
144 | return(tidyLM(x))
145 | } else {
146 | return(tidyRMA(x))
147 | }
148 | }
--------------------------------------------------------------------------------
/original code from others/Colada-37-p-curve-disclosure-table-for-Power-Posing.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/Colada-37-p-curve-disclosure-table-for-Power-Posing.xlsx
--------------------------------------------------------------------------------
/original code from others/Gervais_PowerCode_final.R:
--------------------------------------------------------------------------------
1 | # retrieved from https://osf.io/nipv5/?view_only=533e0b6a3003477fbb7d7dd147b91ef5
2 |
3 | library(pwr)
4 | library(sciplot)
5 | library(psych)
6 | library(brglm)
7 | library(ggplot2)
8 | library(boot)
9 |
10 | setwd("/Users/willgervais/Documents/Google Drive/Secrets/Research/Ongoing Projects/Power/Data & Code")
11 |
12 |
13 | ## Get Data
14 |
15 | Full <- read.table("PowerData.csv", header=T, sep=",")
16 | summary(Full)
17 |
18 | nrow(Full)
19 |
20 |
21 | Pow <- subset(Full, Choice < 1000)
22 | summary(Pow)
23 |
24 | nrow(Pow)
25 |
26 |
27 |
28 |
29 |
30 | #############################################
31 | ####### Confirmatory Analyses: ##############
32 | #### Tests of Registered Hypotheses #########
33 | #############################################
34 |
35 |
36 | ##########################################
37 | ###### Hyp 1: Candidate Choices #########
38 | ##### Will Differ Across Conditions ######
39 | ##########################################
40 |
41 |
42 | ## Does introducing power information change preferences?
43 |
44 |
45 | ## 2 x 3 chi square
46 |
47 | X23 <- table(Pow$Choice, Pow$Condition)
48 | chisq.test(X23)
49 |
50 |
51 |
52 | #####################################
53 | #### Pairwise Comparisons ###########
54 | #####################################
55 |
56 |
57 | #####################################
58 | #### Hyp 2: Order of Preference #####
59 | ## For High Power Candidate Pattern #
60 | ## Findings < SS <<< Consequences ###
61 | #####################################
62 |
63 | # Findings Vs. Sample size
64 |
65 | FS <- subset(Pow, Condition != "Consequences")
66 | summary(FS)
67 |
68 | FS.log <- glm(Choice ~ CondNum, data= FS, family= binomial)
69 | summary(FS.log)
70 | exp(coef(FS.log))
71 | exp(confint(FS.log))
72 |
73 | # Findings Vs. Consequences
74 |
75 | FC <- subset(Pow, Condition != "Sample Size")
76 | FC$CondNum <- FC$CondNum/2
77 | summary(FC)
78 |
79 | FC.log <- brglm(Choice ~ CondNum, data= FC, family= binomial)
80 | summary(FC.log)
81 | exp(coef(FC.log))
82 | exp(confint(FC.log))
83 |
84 |
85 | # SampleSize Vs. Consequences
86 |
87 | SC <- subset(Pow, Condition != "Findings")
88 | SC$CondNum <- SC$CondNum-1
89 | summary(SC)
90 |
91 | SC.log <- brglm(Choice ~ CondNum, data= SC, family= binomial)
92 | summary(SC.log)
93 | exp(coef(SC.log))
94 | exp(confint(SC.log))
95 |
96 | ###########################################
97 | ############ Check preferences ############
98 | ########## within each condition ##########
99 | ###########################################
100 |
101 |
102 | ###########################################
103 | ##### Hyp 3: PPTS will significantly ######
104 | #### prefer low-power candidate in the ####
105 | ## Findings and Sample Size Conditions. ###
106 | ###### This preference reverses in ########
107 | ###### the Consequences condition #########
108 | ###########################################
109 |
110 | Choices <- table(Pow$Choice, Pow$Condition)
111 | prop.table(Choices, 2)
112 | Choices
113 |
114 |
115 | # dif from chance wintin each condition???
116 |
117 |
118 | Findings <- subset(Pow, Condition == "Findings")
119 | SS <- subset(Pow, Condition == "Sample Size")
120 | Cons <- subset(Pow, Condition == "Consequences")
121 |
122 |
123 | #Findings
124 |
125 | F0 <- subset(Findings, Choice == "0")
126 | F1 <- subset(Findings, Choice == "1")
127 |
128 | F0b <- describe(F0$Choice)
129 | F1b <- describe(F1$Choice)
130 |
131 | binom.test(F1b$n, F1b$n + F0b$n, p = .5)
132 |
133 | #Sample Size
134 |
135 | SS0 <- subset(SS, Choice == "0")
136 | SS1 <- subset(SS, Choice == "1")
137 |
138 | SS0b <- describe(SS0$Choice)
139 | SS1b <- describe(SS1$Choice)
140 |
141 | binom.test(SS1b$n, SS1b$n + SS0b$n, p = .5)
142 |
143 |
144 | #Consequences
145 |
146 | Cons0 <- subset(Cons, Choice == "0")
147 | Cons1 <- subset(Cons, Choice == "1")
148 |
149 | Cons0b <- describe(Cons0$Choice)
150 | Cons1b <- describe(Cons1$Choice)
151 |
152 | binom.test(Cons1b$n, Cons1b$n + Cons0b$n, p = .5)
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 | ########################################
166 | ########################################
167 | ### Exploratory and Descriptive Stuff ##
168 | ########################################
169 | ########################################
170 |
171 |
172 |
173 | ########################
174 | ##### Describe #########
175 | ## research Practices###
176 | ########################
177 |
178 |
179 | ##Low
180 |
181 | describe(Pow$NyearLow)
182 |
183 | describe(Pow$DtypicalLow)
184 |
185 | describe(Pow$NconditionLow)
186 |
187 | describe(Pow$PcorrectLow)
188 |
189 |
190 | ##High
191 |
192 | describe(Pow$NyearHigh)
193 |
194 | describe(Pow$DtypicalHigh)
195 |
196 | describe(Pow$NconditionHigh)
197 |
198 | describe(Pow$PcorrectHigh)
199 |
200 |
201 |
202 | ##############################################
203 | #### Calculate power, false pos rate, and ####
204 | ### replication rates from provided info #####
205 | ##############################################
206 |
207 |
208 | ##Using highest provided estimate
209 |
210 |
211 | powerHigh <- power.t.test(d=Pow$DtypicalHigh, power= NULL, n= Pow$NconditionHigh, sig.level=.05, alternative="two.sided")
212 |
213 | Pow$N2.5 <- Pow$NconditionHigh * 2.5
214 |
215 |
216 | powerHigh2.5 <- power.t.test(d=Pow$DtypicalHigh, power= NULL, n= Pow$N2.5, sig.level=.05, alternative="two.sided")
217 |
218 |
219 | Pow$PowerTypicalHigh <- powerHigh$power
220 |
221 |
222 | Pow$PowerTypicalHigh2.5 <- powerHigh2.5$power
223 |
224 |
225 | rightHigh <- Pow$PcorrectHigh * Pow$PowerTypicalHigh
226 |
227 | wrongHigh <- (1-Pow$PcorrectHigh)* .05
228 |
229 | sigrateHigh <- rightHigh + wrongHigh
230 |
231 |
232 | Pow$fprateHigh <- wrongHigh/sigrateHigh
233 |
234 | Pow$reprateHigh <- ((1-Pow$fprateHigh) * Pow$PowerTypicalHigh) + (Pow$fprateHigh * .05)
235 |
236 | Pow$reprateHigh2.5 <- ((1-Pow$fprateHigh) * Pow$PowerTypicalHigh2.5) + (Pow$fprateHigh * .05)
237 |
238 |
239 |
240 |
241 |
242 | Pow$Power50 <- ifelse(Pow$PowerTypicalHigh <= .5, 1, 0)
243 | Pow$Power80 <- ifelse(Pow$PowerTypicalHigh <= .8, 1, 0)
244 | Pow$reprate50 <- ifelse(Pow$reprateHigh <= .5, 1, 0)
245 |
246 | Pow$reprate50.2.5 <- ifelse(Pow$reprateHigh2.5 <= .5, 1, 0)
247 |
248 | myvars <- c("PowerTypicalHigh" ,"fprateHigh", "reprateHigh", "reprateHigh2.5", "Power50", "Power80", "reprate50","reprate50.2.5")
249 | PracticesHigh <- Pow[myvars]
250 |
251 |
252 | describe(PracticesHigh)
253 |
254 | NHigh <- describe(Pow$NconditionHigh)
255 | PHigh <- describe(Pow$PowerTypicalHigh)
256 | fHigh <- describe(Pow$fprateHigh)
257 | rHigh <- describe(Pow$reprateHigh)
258 |
259 |
260 | par(mfrow=c(2,2))
261 |
262 | n <- density(Pow$NconditionHigh, na.rm=TRUE)
263 | plot(n, main="N per conditon", xlim= c(0, 150))
264 | polygon(n, col="cornflowerblue", border="black")
265 | abline(v=NHigh$median, lty=3, col="green")
266 |
267 |
268 | pwr <- density(Pow$PowerTypicalHigh, na.rm=TRUE)
269 | plot(pwr, main="Power", xlim= c(0, 1))
270 | polygon(pwr, col="cornflowerblue", border="black")
271 | abline(v=PHigh$median, lty=3, col="green")
272 |
273 |
274 |
275 | fp <- density(Pow$fprateHigh, na.rm=TRUE)
276 | plot(fp, main="False Positive Rate", xlim= c(0, 1))
277 | polygon(fp, col="cornflowerblue", border="black")
278 | abline(v=fHigh$median, lty=3, col="green")
279 |
280 |
281 | rep <- density(Pow$reprateHigh, na.rm=TRUE)
282 | plot(rep, main="Replication Rate", xlim= c(0, 1))
283 | polygon(rep, col="cornflowerblue", border="black")
284 | abline(v=rHigh$median, lty=3, col="green")
285 |
286 |
287 | ######################################
288 | ######### Exploratory Analyses: ######
289 | #### to see if institution, rank #####
290 | ## or practices (N & Power) predict ##
291 | ###### choice of candidates ##########
292 | ######################################
293 |
294 | ## Does the effect differ by academic rank?
295 |
296 |
297 | Pow$N10 <- Pow$NconditionHigh/10
298 | Pow$Pow10 <- Pow$PowerTypicalHigh/10
299 |
300 | Findings <- subset(Pow, Condition == "Findings")
301 | SS <- subset(Pow, Condition == "Sample Size")
302 | Cons <- subset(Pow, Condition == "Consequences")
303 |
304 |
305 |
306 | FRank <- table(Findings$Choice, Findings$RankID)
307 | chisq.test(FRank)
308 |
309 |
310 | SSRank <- table(SS$Choice, SS$RankID)
311 | chisq.test(SSRank)
312 |
313 | CRank <- table(Cons$Choice, Cons$RankID)
314 | chisq.test(CRank)
315 |
316 |
317 |
318 | ## Does the effect differ by institution?
319 |
320 |
321 | FInst <- table(Findings$Choice, Findings$InstID)
322 | chisq.test(FInst)
323 |
324 |
325 | SSInst <- table(SS$Choice, SS$InstID)
326 | chisq.test(SSInst)
327 |
328 | CInst <- table(Cons$Choice, Cons$InstID)
329 | chisq.test(CInst)
330 |
331 |
332 | ## Does a participant's typical sample size relate to preferences when sample size is given? Consequences?
333 |
334 |
335 |
336 |
337 |
338 |
339 | NS.log <- glm(Choice ~ N10, data=SS, family = binomial)
340 | summary(NS.log)
341 | exp(coef(NS.log))
342 | exp(confint(NS.log))
343 |
344 |
345 | NC.log <- glm(Choice ~ N10, data=Cons, family = binomial)
346 | summary(NC.log)
347 | exp(coef(NC.log))
348 | exp(confint(NC.log))
349 |
350 |
351 | ## Does participant typical power relate to decisions?
352 |
353 |
354 | #scale power to .10 increments
355 |
356 |
357 |
358 | PS.log <- glm(Choice ~ Pow10, data=SS, family = binomial)
359 | summary(PS.log)
360 | exp(coef(PS.log))
361 | exp(confint(PS.log))
362 |
363 |
364 | PC.log <- brglm(Choice ~ Pow10, data=Cons, family = binomial)
365 | summary(PC.log)
366 | exp(coef(PC.log))
367 | exp(confint(PC.log))
368 |
369 |
370 |
371 |
372 |
373 |
374 |
375 |
376 |
377 | ######################
378 | ## Demographics ######
379 | ######################
380 |
381 | #Age
382 | describe(Pow$Age)
383 |
384 | #Gender
385 | Pow$Gender <- factor(Pow$GenFem, levels = c("0", "1", "2"), labels= c("Male", "Female", "Other"))
386 |
387 | GenTab <- table(Pow$Gender)
388 | prop.table(GenTab)
389 |
390 | #Institution
391 |
392 | Pow$Institution <- factor(Pow$InstID, levels = c("1", "2", "3", "4", "5"), labels = c("R1", "R2", "MA", "SLAC", "Other"))
393 |
394 | InTab <- table(Pow$Institution)
395 | prop.table(InTab)
396 |
397 | #Rank
398 |
399 | Pow$Rank <- factor(Pow$RankID, levels = c("1", "2", "3", "4", "5"), labels = c("Assistant", "Associate", "Full", "Emeritus", "Other"))
400 |
401 | RTab <- table(Pow$Rank)
402 | prop.table(RTab)
403 |
404 |
405 |
406 | #### Graph it ####
407 | # Fig 2
408 |
409 | Condition = c("Findings", "Sample Size", "Consequences")
410 | prob = c(.217, .610, .966)
411 | lcl = c(.121, .474, .880)
412 | ucl = c(.342, .735, .996)
413 | dat <- data.frame(Condition, prob, lcl, ucl)
414 |
415 | summary(dat)
416 |
417 | dat$Cond <- factor(dat$Condition, levels = c("Findings", "Sample Size", "Consequences"))
418 |
419 | quartz()
420 | ggplot(data=dat, aes(x= Cond, y = prob, ymin = lcl, ymax=ucl)) + geom_pointrange(col="black", size=.666) + labs(x= "\nCondition", y = "Proportion Choosing \nLarger Sample Size Candidate \n ", title="Hiring Preferences \n") + theme_bw() + scale_y_continuous(breaks = c(0, .25, .5, .75, 1)) + geom_hline(yintercept=.5, lty=3, col="darkgrey") + geom_hline(yintercept=0, lty=1, col="darkgrey") + geom_hline(yintercept=1, lty=1, col="darkgrey") + theme(plot.title = element_text(size = rel(1.2), face="bold"))
421 |
422 |
423 |
424 |
425 |
--------------------------------------------------------------------------------
/original code from others/Roth-IQ.ods:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/Roth-IQ.ods
--------------------------------------------------------------------------------
/original code from others/Shanks Meta-analysis_data.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/Shanks Meta-analysis_data.xlsx
--------------------------------------------------------------------------------
/original code from others/Simonsohn_p-curve-code.R:
--------------------------------------------------------------------------------
1 |
2 | #R Code running behind p-curve.com/App3
3 | #Written by Uri Simonsohn (uws@wharton.upenn.edu)
4 | #This version: 2015 03 02
5 | #
6 | # <-- PLEASE CONTACT ME DIRECTLY IF YOU SEE ANY ERRORS OR HAVE SUGGESTIONS -->
7 |
8 | # Note:
9 | #The code below has some redundancies because it merges code written for two different papers
10 | #Some of the clunkiness of the code (e.g., how results are reported) arises because the code
11 | #was written to run on a server and save results that are then presented on a website.
12 | #It was adapted to be run on a personal computer introducing the least # of changes possible to the code.
13 | #
14 |
15 | ############################################################################################################
16 |
17 | # R E A D M E #
18 | # (---------(0)------------(0)---------------)
19 |
20 | #ENTER/LOAD YOUR TEST RESULTS HERE: (USE THIS SYNTAX)
21 | tests = c("t(88)=2.1",
22 | "r(147)=.246",
23 | "F(1,100)=9.1",
24 | "f(2,210)=4.45",
25 | "Z=3.45",
26 | "chi2(1)=9.1",
27 | "r(77)=.47",
28 | "chi2(2)=8.74")
29 |
30 | #RUN ALL CODE UP TO #14 TO GET MAIN RESULTS, P-CURVE CHART, AND POWER CHART
31 | #THEN RUN CODE #15 TO GET THE CUMULATIVE P-CURVE (DROPPING STUDIES)
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 | ############################################################################################################
40 |
41 | #Load libraries necessary to run programs
42 | library(stringr) #Library to process string variables (text of the entered tests)
43 | library(poibin) #This library has the Poisson binomial, the distribution of the sum of binomial with different
44 | #underlying probabilities used to compute the binomial test given that each test has a (slightly)
45 | #different probability of p<.025 depending on its own non-central parameter
46 | #See Hong (2013) - "On computing the distribution function for the Poisson binomial distribution" Computational
47 | #Statistics and Data Analysis, V59, p.41-51 - http://dx.doi.org/10.1016/j.csda.2012.10.006
48 |
49 |
50 | #1. create empty vectors for
51 | #1.1 pp-values
52 | t.ppr=f.ppr=c.ppr=z.ppr=c(); #right skew
53 | t.ppl=f.ppl=c.ppl=z.ppl=c(); #left
54 | t.pp33=f.pp33=c.pp33=z.pp33=c(); #33%
55 |
56 | #1.2 proportions expected to be low (p<.025) for each test
57 | t.plow=f.plow=c.plow=z.plow=c()
58 |
59 | #1.3 proportions for all tests are 0 so that if a type of test is missing we know it is not there when aggregating
60 | t.prop1=t.prop2=t.prop3=t.prop4=t.prop5=0;
61 | f.prop1=f.prop2=f.prop3=f.prop4=f.prop5=0;
62 | z.prop1=z.prop2=z.prop3=z.prop4=z.prop5=0;
63 | c.prop1=c.prop2=c.prop3=c.prop4=c.prop5=0;
64 |
65 |
66 | #1.4 Function 1 - functions that find noncentrality parameter for t,f,chi distributions that gives 33% power for those d.f.
67 |
68 | #t-test
69 | ncp33t =function(df)
70 | {
71 | xc=qt(p=1-.05/2, df=df)
72 | #Find noncentrality parameter (ncp) that leads 33% power to obtain xc
73 | f = function(delta, pr, x, df) pt(x, df = df, ncp = delta) - 2/3
74 | out = uniroot(f, c(0, 37.62), x = xc, df = df)
75 | return(out$root)
76 | }
77 |
78 | #F-test
79 | ncp33f =function(df1,df2)
80 | {
81 | xc=qf(p=1-.05,df1=df1,df2=df2)
82 | f = function(delta, pr, x, df1,df2) pf(x, df1 = df1, df2=df2, ncp = delta) - 2/3
83 | out = uniroot(f, c(0, 37.62), x = xc, df1=df1, df2=df2)
84 | return(out$root)
85 | }
86 |
87 | #chi-square
88 | ncp33chi =function(df)
89 | {
90 | xc=qchisq(p=1-.05, df=df)
91 | #Find noncentrality parameter (ncp) that leads 33% power to obtain xc
92 | f = function(delta, pr, x, df) pchisq(x, df = df, ncp = delta) - 2/3
93 | out = uniroot(f, c(0, 37.62), x = xc, df = df)
94 | return(out$root)
95 | }
96 |
97 |
98 | ###############################################################################
99 |
100 | #Function 2 - percent() : makes a number look like a percentage
101 | percent <- function(x, digits = 0, format = "f", ...) {
102 | paste(formatC(100 * x, format = format, digits = digits, ...), "%", sep = "")
103 | }
104 | ###############################################################################
105 |
106 | #Create a "backup" so that final results table includes the n.s. results which will be excluded from most calculations
107 | #(not really important here, key for the online app)
108 | k=seq(from=1,to=length(tests))
109 | backup=cbind(k,tests)
110 |
111 | #(2) Split tests into t,F,X2 and Z
112 |
113 | #2.1 Turn everything to lower case
114 | tests=tolower(tests)
115 |
116 | #2.2 Extract the type of test (stat={t,F,c,Z)
117 | stat=substring(tests,1,1)
118 |
119 | #2.3 Split vector of tests into these
120 | #get the t-tests
121 | t.text=subset(tests,stat=="t")
122 | #get the f-tests
123 | f.text=subset(tests,stat=="f")
124 | #get the chi2
125 | c.text=subset(tests,stat=="c" | stat=="x")
126 | #get the Z (normally distributed)
127 | z.text=subset(tests,stat=="z")
128 | #get the r (correlation)
129 | r.text=subset(tests,stat=="r")
130 |
131 | #3 Get d.f. for the tests
132 | #3.1 t-test
133 | #find the 2nd parenthesis
134 | t.par=str_locate(t.text,")")[,1]
135 | #Get the d.f. between both parenthesis
136 | t.df=as.numeric(substring(t.text,3,t.par -1))
137 |
138 | #3.2 f-test
139 | #find the comma
140 | f.comma=str_locate(f.text,",")[,1]
141 | #find the 2nd parenthesis
142 | f.par=str_locate(f.text,")")[,1]
143 | #Get the df1 (between "(" and ","
144 | f.df1=as.numeric(substring(f.text,3,f.comma -1))
145 | #Get the df2 (between "," and ")"
146 | f.df2=as.numeric(substring(f.text,f.comma +1,f.par -1))
147 |
148 | #3.3 Chi-square
149 | #find the 1st parenthesis
150 | c.par1=str_locate(c.text,"\\(")[,1]
151 | #find the 2nd parenthesis
152 | c.par2=str_locate(c.text,")")[,1]
153 | #Get the d.f. between both parenthesis
154 | c.df=as.numeric(substring(c.text,c.par1+1,c.par2 -1))
155 |
156 | #3.4 Correlations
157 | #fine the 2nd parenthesis
158 | r.par=str_locate(r.text,")")[,1]
159 | #Get the d.f. between both parenthesis
160 | r.df=as.numeric(substring(r.text,3,r.par -1))
161 |
162 |
163 | #4 Get the test values
164 | #4.1 Find the "=" sign
165 | t.eq=str_locate(t.text,"=")[,1]
166 | f.eq=str_locate(f.text,"=")[,1]
167 | z.eq=str_locate(z.text,"=")[,1]
168 | c.eq=str_locate(c.text,"=")[,1]
169 | r.eq=str_locate(r.text,"=")[,1]
170 |
171 | #4.2 Get the number after the =
172 | t.value=c();r.value=c()
173 |
174 | t.value=as.numeric(substring(t.text,t.eq+1,))
175 | f.value=as.numeric(substring(f.text,f.eq+1,))
176 | z.value=as.numeric(substring(z.text,z.eq+1,))
177 | c.value=as.numeric(substring(c.text,c.eq+1,))
178 | r.value=as.numeric(substring(r.text,r.eq+1,))
179 |
180 | #4.3 merge r() with t-tests
181 | rt.value=r.value/(sqrt((1-r.value**2)/r.df)) #r() expressed as a t-value
182 | t.value=c(t.value,rt.value)
183 | t.df=c(t.df,r.df)
184 | t.text=c(t.text,r.text)
185 |
186 |
187 | #5 Keep significant p-values
188 | #Compute p-values
189 | t.p=2*(1-pt(abs(t.value),df=t.df))
190 | f.p=1-pf(abs(f.value),df1=f.df1,df2=f.df2)
191 | z.p=2*(1-pnorm(abs(z.value)))
192 | c.p=1-pchisq(abs(c.value),df=c.df)
193 |
194 | #Subset statistics and d.f.
195 | #ts
196 | t.value.sig=subset(t.value,t.p<.05)
197 | t.df.sig =subset(t.df, t.p<.05)
198 | t.text.sig =subset(t.text, t.p<.05)
199 | t.p.sig =subset(t.p, t.p<.05)
200 | #fs
201 | f.value.sig=subset(f.value,f.p<.05)
202 | f.df1.sig =subset(f.df1, f.p<.05)
203 | f.df2.sig =subset(f.df2, f.p<.05)
204 | f.text.sig =subset(f.text, f.p<.05)
205 | f.p.sig =subset(f.p, f.p<.05)
206 | #chis
207 | c.value.sig=subset(c.value,c.p<.05)
208 | c.df.sig =subset(c.df, c.p<.05)
209 | c.text.sig =subset(c.text, c.p<.05)
210 | c.p.sig =subset(c.p, c.p<.05)
211 | #zs
212 | z.value.sig=subset(z.value,z.p<.05)
213 | z.text.sig =subset(z.text, z.p<.05)
214 | z.p.sig =subset(z.p, z.p<.05)
215 |
216 | #All significant p-values (used for binomial)
217 | all.p.sig=c(t.p.sig, f.p.sig, c.p.sig, z.p.sig)
218 | #Number of significant results
219 | ktot=length(all.p.sig)
220 | #Number of non-signifcant results in p-curve
221 | kns=length(tests)-ktot
222 |
223 | #6 Compute pp-values
224 | #6.1 For t-values
225 | if (length(t.value.sig)>0) #if nonempty compute pp-values
226 | {
227 | #skew
228 | t.ppr=t.p.sig*(1/.05) #pp-value for right-skew
229 | t.ppl=1-t.ppr #pp-value for left-skew
230 | #33%power
231 | #Find the ncp (uses function from top)
232 | t.ncp33=mapply(ncp33t,t.df.sig)
233 | #Using the ncp33 compute pp33.
234 | t.pp33=3*(pt(t.value.sig, df=t.df.sig, ncp=t.ncp33)-2/3)
235 | }
236 |
237 | #6.2 For F-values
238 | if (length(f.value.sig)>0) #if nonempty compute pp-values
239 | {
240 | f.ppr=f.p.sig*(1/.05) #pp-value for right-skew
241 | f.ppl=1-f.ppr #pp-value for left-skew
242 | f.ncp33=mapply(ncp33f, f.df1.sig, f.df2.sig)
243 | f.pp33 =3*(pf(f.value.sig, df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3)
244 | }
245 |
246 | #6.3 z-values
247 | if (length(z.value.sig)>0) #if nonempty compute pp-values
248 | {
249 | z.ppr=z.p.sig*(1/.05)
250 | z.ppl=1-z.ppr
251 | z.pp33=3*(pnorm(z.value.sig,mean=1.5285687,sd=1)-2/3) #Compute pp33-values using the 'ncp' 1.5285687 which gives the normal 33% power
252 |
253 | }
254 |
255 | #6.4 chi-values
256 | if (length(c.value.sig)>0) #if nonempty compute pp-values
257 | {
258 | c.ppr=c.p.sig*(1/.05)
259 | c.ppl=1-c.ppr
260 | c.ncp33=mapply(ncp33chi, c.df.sig)
261 | c.pp33=3*(pchisq(c.value.sig, df=c.df.sig, ncp=c.ncp33)-2/3)
262 | }
263 |
264 |
265 | #7 STOUFFER: Overall tests aggregating pp-values (using Fisher's method to aggregate uniform distributions of (p)p-values)
266 | #7.1 Convert pp-values to Z scores, aggregate them and divide by sqrt(ktot)
267 | Zppr =sum(qnorm(c(t.ppr, f.ppr ,c.ppr, z.ppr )))/sqrt(ktot) #right skew
268 | Zppl =sum(qnorm(c(t.ppl, f.ppl ,c.ppl, z.ppl )))/sqrt(ktot) #left skew
269 | Zpp33=sum(qnorm(c(t.pp33, f.pp33 ,c.pp33, z.pp33)))/sqrt(ktot) #33%
270 |
271 | #7.2 Compute overall p-values
272 | p.Zppr =pnorm(Zppr)
273 | p.Zppl =pnorm(Zppl)
274 | p.Zpp33=pnorm(Zpp33)
275 |
276 |
277 | #8 Green line (Expected p-curve for 33% power)
278 | #8.1 t-tests
279 | if (length(t.value.sig)>0) #if nonempty compute pp-values
280 | {
281 | #Critical values,xc, for p=.05, .04, .03, .02 and ,01
282 | t.x5=qt(.975,df=t.df.sig); t.x4=qt(.98, df=t.df.sig); t.x3=qt(.985,df=t.df.sig);
283 | t.x2=qt(.99, df=t.df.sig); t.x1=qt(.995,df=t.df.sig)
284 | #For Binomial test
285 | t.x25=qt(.9875,df=t.df.sig) #critical value for t-tests to get p=.025
286 | t.plow=1- 3*(pt(t.x25,df=t.df.sig, ncp=t.ncp33)-2/3) #prob(p<.025 | ncp33% & p<.05)
287 |
288 | #Probabilty of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
289 | t.pp4=3*(pt(t.x4,df=t.df.sig, ncp=t.ncp33)-2/3)
290 | t.pp3=3*(pt(t.x3,df=t.df.sig, ncp=t.ncp33)-2/3)
291 | t.pp2=3*(pt(t.x2,df=t.df.sig, ncp=t.ncp33)-2/3)
292 | t.pp1=3*(pt(t.x1,df=t.df.sig, ncp=t.ncp33)-2/3)
293 | #within bins proportions
294 | t.prop5=mean(t.pp4);
295 | t.prop4=mean(t.pp3-t.pp4);
296 | t.prop3=mean(t.pp2-t.pp3);
297 | t.prop2=mean(t.pp1-t.pp2);
298 | t.prop1=mean(1-t.pp1)
299 | }
300 | #8.2 f-tests
301 | if (length(f.value.sig)>0) #if nonempty compute pp-values
302 | {
303 | #Critical values,xc, for p=.05, .04, .03, .02 and ,01
304 | f.x5=qf(.95,df1=f.df1.sig, df2=f.df2.sig); f.x4=qf(.96,df1=f.df1.sig, df2=f.df2.sig); f.x3=qf(.97,,df1=f.df1.sig, df2=f.df2.sig);
305 | f.x2=qf(.98, df1=f.df1.sig, df2=f.df2.sig); f.x1=qf(.99,df1=f.df1.sig, df2=f.df2.sig)
306 | #For binomial test
307 | f.x25 =qf(.975,df1=f.df1.sig, df2=f.df2.sig) #Critical F value for p=.025
308 | f.plow=1-3*(pf(f.x25,df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3) #Prob(p<.025|ncp33% & p<.05)
309 |
310 |
311 | #Probabilty of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
312 | f.pp4=3*(pf(f.x4,df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3)
313 | f.pp3=3*(pf(f.x3,df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3)
314 | f.pp2=3*(pf(f.x2,df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3)
315 | f.pp1=3*(pf(f.x1,df1=f.df1.sig, df2=f.df2.sig, ncp=f.ncp33)-2/3)
316 |
317 | #within bins proportions
318 | f.prop5=mean(f.pp4);
319 | f.prop4=mean(f.pp3-f.pp4);
320 | f.prop3=mean(f.pp2-f.pp3);
321 | f.prop2=mean(f.pp1-f.pp2);
322 | f.prop1=mean(1-f.pp1)
323 | }
324 | #8.3 chi-tests
325 | if (length(c.value.sig)>0) #if nonempty compute pp-values
326 | {
327 |
328 | #Critical values,xc, for p=.05, .04, .03, .02 and ,01
329 | c.x5=qchisq(.95,df=c.df.sig); c.x4=qchisq(.96, df=c.df.sig); c.x3=qchisq(.97,df=c.df.sig);
330 | c.x2=qchisq(.98, df=c.df.sig); c.x1=qchisq(.99,df=c.df.sig)
331 |
332 | #For binomial test
333 | c.x25 =qchisq(.975,df=c.df.sig) #Critical x2 value for p=.025
334 | c.plow=1-3*(pchisq(c.x25,df=c.df.sig, ncp=c.ncp33)-2/3) #Prob(p<.025|ncp33% & p<.05)
335 |
336 | #Probabilty of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
337 | c.pp4=3*(pchisq(c.x4,df=c.df.sig, ncp=c.ncp33)-2/3)
338 | c.pp3=3*(pchisq(c.x3,df=c.df.sig, ncp=c.ncp33)-2/3)
339 | c.pp2=3*(pchisq(c.x2,df=c.df.sig, ncp=c.ncp33)-2/3)
340 | c.pp1=3*(pchisq(c.x1,df=c.df.sig, ncp=c.ncp33)-2/3)
341 |
342 | #within bins proportions
343 | c.prop5=mean(c.pp4); c.prop4=mean(c.pp3-c.pp4); c.prop3=mean(c.pp2-c.pp3);
344 | c.prop2=mean(c.pp1-c.pp2); c.prop1=mean(1-c.pp1)
345 | }
346 | #8.4 z-tests
347 | if (length(z.value.sig)>0) #if nonempty compute pp-values
348 | {
349 | #Critical values,xc, for p=.05, .04, .03, .02 and ,01
350 | z.x5=qnorm(.975); z.x4=qnorm(.98); z.x3=qnorm(.985); z.x2=qnorm(.99); z.x1=qnorm(.995)
351 | # For Binomial test
352 | z.x25 =qnorm(.9825) #Critical x2 value for p=.025
353 | z.plow=1-3*(pnorm(z.x25,mean=1.5285687,sd=1)-2/3) #Prob(p<.025|ncp33% & p<.05)
354 | #Probabilty of a p-value bigger p=.05, .04, .03, .02 and .01, given p<.05 and ncp=ncp33
355 | z.pp4=3*(pnorm(z.x4,mean=1.5285687,sd=1)-2/3)
356 | z.pp3=3*(pnorm(z.x3,mean=1.5285687,sd=1)-2/3)
357 | z.pp2=3*(pnorm(z.x2,mean=1.5285687,sd=1)-2/3)
358 | z.pp1=3*(pnorm(z.x1,mean=1.5285687,sd=1)-2/3)
359 | #within bins proportions
360 | z.prop5=z.pp4; z.prop4=z.pp3-z.pp4; z.prop3=z.pp2-z.pp3; z.prop2=z.pp1-z.pp2; z.prop1=1-z.pp1
361 | }
362 |
363 |
364 | #9 combine t,F,chi,Z
365 | #proportion of all tests that are of each type
366 | t.share=length(t.value.sig)/ktot
367 | f.share=length(f.value.sig)/ktot
368 | c.share=length(c.value.sig)/ktot
369 | z.share=length(z.value.sig)/ktot
370 |
371 | #Average proportions within the 4 types of tests
372 | t.props=c(t.prop1, t.prop2, t.prop3, t.prop4, t.prop5)
373 | f.props=c(f.prop1, f.prop2, f.prop3, f.prop4, f.prop5)
374 | c.props=c(c.prop1, c.prop2, c.prop3, c.prop4, c.prop5)
375 | z.props=c(z.prop1, z.prop2, z.prop3, z.prop4, z.prop5)
376 |
377 | #overall proportions (i.e.., THE GREEN LINE)
378 | green=100*(t.props*t.share + f.props*f.share + c.props*c.share + z.props*z.share)
379 |
380 |
381 | #10 The blue line (observed p-curve)
382 |
383 | #Put each p-value in a bin between 0 and .05
384 | ps=ceiling(c(all.p.sig)*100)/100
385 | #Count them
386 | blue01=sum(ps<=.01)/ktot; blue02=sum(ps==.02)/ktot; blue03=sum(ps==.03)/ktot;
387 | blue04=sum(ps==.04)/ktot; blue05=sum(ps==.05)/ktot;
388 | #combine
389 | blue=c(blue01,blue02,blue03,blue04,blue05)*100
390 | #Note: i could have used the Table command, but it is a pain if there are no p-value in a given range
391 |
392 | #11 Red line
393 | red=c(20,20,20,20,20)
394 |
395 | #12 Carry out binomial test
396 | #Note: for t and Z test, the critical value is for p=.0125 one sided, for Z and Chi2 it is for .025 two-sided
397 |
398 |
399 | #12.1 Combine the prob(p<.025) for each set of tests
400 | plows=c(t.plow, f.plow, c.plow, z.plow)
401 | #12.2 Compute observed shared of p<.025 results
402 | low.obs=sum(all.p.sig<=.025)
403 | #12.3 Right skew: Compare observed share p<.025 with null of 50:50 and altenrative of more p<.025 than expected
404 | binom.r=1-pbinom(q=low.obs-1, p=.5, size=ktot) #The binomial in R computes the probability of x<=xo. We want prob(x>=x0) so we subtract one from x, and 1-prob()
405 | #12.4 Left skew: Compare observed share p<.025 with null of 50:50 and altenrative of fewer p<.025 than expected
406 | binom.l=pbinom(q=low.obs, p=.5, size=ktot) #Here the default x<=x0 is what we want
407 | #12.5 33% power: Compare observed share p<.025 with expected share ~72% based on the combination of expected shares for ncp33%
408 | # The probability of p<.025|ncp33 is slightly different for each test, hence I use the poisson binomial distribtuion (see reference top of this document)
409 | binom.33=ppoibin(kk=low.obs,pp=plows)
410 |
411 |
412 | #13.POWER ESTIMATION
413 |
414 | #13.1 SET OF FUNCTIONS 1. COMPUTE GAP BETWEEN POWER AND DESIRED POWER FOR A GIVEN NCP
415 | # (minimize these in the next step to solve for the ncp that gives the desired power)
416 | ncp_error.t = function(delta, power, x, df) pt(x, df = df, ncp = delta) - (1-power) #if this equals 0, we found the ncp.
417 | ncp_error.f = function(delta, power, x, df1,df2) pf(x, df1 = df1, df2=df2, ncp = delta) - (1-power)
418 | ncp_error.c = function(delta, power, x, df) pchisq(x, df = df, ncp = delta) - (1-power)
419 | ncp_error.z = function(delta, power, x) pnorm(x, mean = delta,sd=1) - (1-power)
420 |
421 | #13.2 SET OF FUNCTIONS 2: MINIMIZE FUNCTIONS ABOVE
422 | #t-test
423 | getncp.t =function(df, power) {
424 | xc=qt(p=.975, df=df) # critical t-value
425 | return(uniroot(ncp_error.t, c(0, 37.62), x = xc, df =df, power=power)$root) }
426 |
427 | #F-test
428 | getncp.f =function(df1,df2, power) {
429 | xc=qf(p=.95, df1=df1,df2=df2) # critical F-value
430 | return(uniroot(ncp_error.f, c(0, 37.62), x = xc, df1 = df1,df2=df2, power=power)$root) }
431 |
432 |
433 | #chisq-test
434 | getncp.c =function(df, power) {
435 | xc=qchisq(p=.95, df=df) # critical c-value
436 | return(uniroot(ncp_error.c, c(0, 37.62), x = xc, df = df, power=power)$root) }
437 |
438 | #Normal
439 | getncp.z =function(power) {
440 | xc=qnorm(p=.975) # critical Z-value with df=1
441 | return(uniroot(ncp_error.z, c(0, 37.62), x = xc, power=power)$root) }
442 |
443 | # 13.3 CREATE PP-VALUES FOR EACH OF THE FOUR DISTRIBUTIONS FOR HOW WELL A GIVEN POWER_EST FITS
444 | powerfit.t=function(t_obs, df_obs, power_est) {
445 | ncp_est=mapply(getncp.t,df=df_obs,power=power_est) #find ncp for each that gives each test power.k
446 | p_larger=pt(t_obs,df=df_obs,ncp=ncp_est) #prob t>tobs given ncp_est
447 | ppr=(p_larger-(1-power_est))/power_est #condition on p<.05
448 | return(ppr) }
449 |
450 | powerfit.f=function(f_obs, df1_obs, df2_obs, power_est) {
451 | ncp_est=mapply(getncp.f,df1=df1_obs, df2=df2_obs,power=power_est) #find ncp for each that gives each test power.k
452 | p_larger=pf(f_obs,df1=df1_obs,df2=df2_obs, ncp=ncp_est) #prob t>tobs given ncp_est
453 | ppr=(p_larger-(1-power_est))/power_est #condition on p<.05
454 | return(ppr) }
455 |
456 | powerfit.z=function(z_obs, power_est) {
457 | ncp_est=mapply(getncp.z,power=power_est)
458 | p_larger=pnorm(z_obs,mean=ncp_est)
459 | ppr=(p_larger-(1-power_est))/power_est
460 | return(ppr) }
461 |
462 |
463 | powerfit.c=function(c_obs, df_obs, power_est) {
464 | ncp_est=mapply(getncp.c,df=df_obs,power=power_est)
465 | p_larger=pchisq(c_obs,df=df_obs,ncp=ncp_est)
466 | ppr=(p_larger-(1-power_est))/power_est
467 | return(ppr) }
468 |
469 | #13.4 STACK-UP ALL THE PP-VALUES INTO A VECTOR AND COMPARE THEM TO UNIFORM DISTRIBUTION USING KOLMOGOROV-SMIRNOV TEST
470 |
471 | powerfit.all=function(power_est)
472 | {
473 | ppr.all=c()
474 | #for each kind of test, check if there are any significant values, if there are, add ppr to overall ppr
475 | if (length(t.value.sig)>0) ppr.all=c(ppr.all, powerfit.t(t_obs=t.value.sig, df_obs=t.df.sig, power_est=power_est))
476 | if (length(f.value.sig)>0) ppr.all=c(ppr.all, powerfit.f(f_obs=f.value.sig, df1_obs=f.df1.sig, df2_obs=f.df2.sig, power_est=power_est))
477 | if (length(z.value.sig)>0) ppr.all=c(ppr.all, powerfit.z(z_obs=z.value.sig, power_est=power_est))
478 | if (length(c.value.sig)>0) ppr.all=c(ppr.all, powerfit.c(c_obs=c.value.sig, df_obs=c.df.sig, power_est=power_est))
479 | KSD=ks.test(ppr.all,punif)$statistic #KS test on the resulting pprs
480 | return(KSD)
481 | }
482 |
483 | #13.5 FUNCTION THAT COMPUTES FIT FOR EACH LEVEL OF POWER, AND PLOT IT
484 |
485 |
486 | plotfit=function()
487 | {
488 | # Fit will be evaluated at every possible value of power between 5.1% and 99% in steps of 1%, stored in fit()
489 | fit=c() #Create empty vector
490 | fit=powerfit.all(.051) #First evaluate fit for power of 5.1%, the lowest one can get for non-directional tests like x2 and F
491 | for (i in 6:99) fit=c(fit,powerfit.all(i/100)) #Now do 6% to 99%
492 | # Find the minimum
493 | mini=match(min(fit),fit) #which ith power level considered leads to best estimate
494 | hat=(mini+4)/100 #convert that into the power level, the ith value considered is (5+ith)/100
495 | #Plot results
496 | #create the x-axis
497 | x.power=seq(from=5,to=99)/100
498 | #Draw the line
499 | par(mar=c(5.1,8.1,4.1,2.1))
500 | plot(x.power,fit,xlab="Underlying Power", ylab="",ylim=c(0,1), main="")
501 | #Make red dot at the estimate
502 | points(hat,min(fit),pch=19,col="red",cex=2)
503 | #Put a label with the estimate value
504 | sign="="
505 | if (hat<.06) sign="<"
506 | text(min(.7,max(.28,hat)),min(fit)-.1,paste0("Estimated Power ",sign," ",hat*100,"%"))
507 | mtext(c("Perfect","Terrible"),side=2,line=3,at=c(0,1),las=1,cex=1.25,col=c("blue","red"))
508 | mtext("How Good Is the Fit?",side=2,line=6.5,cex=1.5)
509 | mtext("(Kolmogorov-Smirnov D Stat)",side=2,line=5.5,col="gray")
510 | mtext("Do we have a good estimate of power?",side=3,line=1.75,cex=1.5,at=0.4)
511 | mtext("If you see a V-Shape with a low minimum-->yes",side=3,line=0.5,cex=1.25,at=0.4)
512 |
513 | }
514 |
515 | #Create two graphs in a single chart
516 | par(mfrow=c(2,1))
517 |
518 | #14 Firest the p-curve itself
519 | #Define x-axis as p-values (.01, .02..)
520 | x = c(.01,.02,.03,.04,.05)
521 |
522 | #Plot the observed p-curve
523 |
524 | plot(x,blue, type='l', col='dodgerblue2', main="",lwd=2, xlab="", ylab="",
525 | xaxt="n",yaxt="n", xlim=c(0.01,0.055), ylim=c(0,105), bty='L', las=1);
526 |
527 | #x-axis value labels
528 | x_=c(".01",".02",".03",".04",".05")
529 | axis(1,at=x,labels=x_)
530 | #y-axis value labels
531 | y_=c("0%","25%","50%","75%","100%")
532 | y=c(0,25,50,75,100)
533 | axis(2,at=y,labels=y_,las=1,cex.axis=.75)
534 |
535 | #Add y-axis label
536 | mtext("Percentage of test results",font=2,side=2,line=2.75,cex=1.25)
537 | #Add y-axis label
538 | mtext("p ",font=4,side=1,line=2.5,cex=1.25)
539 | mtext(" -value",font=2,side=1,line=2.5,cex=1.25)
540 |
541 |
542 | #Add little point in actual frequencies
543 | points(x,blue,type="p",pch=20,bg="dodgerblue2",col="dodgerblue2")
544 | #Add value-labels
545 | text(x+.00075,blue+5,percent(round(blue)/100),col='black', cex=.75)
546 | #Add red and green lines
547 | lines(x,red, type='l', col='firebrick2', lwd=1.5, lty=3)
548 | lines(x,green, type='l', col='springgreen4', lwd=1.5, lty=5)
549 |
550 | #Legend
551 | #By default its x-position, legendx, is in the middle
552 | legendx=.035 ;
553 | #Move left for p-curves that have more 80% of p-values =.02 or =.03 so that the legend does not touch blue line
554 | if (blue04>.80 | blue05>.80) legendx=.02
555 | #Print legend
556 | legend(legendx, 100, c('Observed p-curve','Null of 33% power', 'Null of zero effect'),
557 | box.col="white",lty=c(1,5,3), cex=.75,lwd=c(1,1),col=c('dodgerblue2','springgreen4', 'firebrick2'));
558 |
559 | #ADD THE POWER FIT CHART
560 | plotfit()
561 |
562 | #PRINT OUT RESULTS
563 | printout=function()
564 | {cat("\nTest for right-skew....Binomial: ",binom.r," Continuous: Z=",Zppr," p=",p.Zppr)
565 | cat("\nTest for 33%....Binomial: ",binom.33," Continuous: Z=",Zpp33," p=",p.Zpp33)
566 | cat("\nTest for left-skew....Binomial: ",binom.l," Continuous: Z=",Zppl," p=",p.Zppl)
567 | }
568 | printout()
569 |
570 |
571 |
572 |
573 |
574 |
575 |
576 |
577 |
578 |
579 |
580 |
581 | ################################################
582 | #15 Cumulative test
583 | #MAKE CUMULATIVE CONDITIONAL ON SIGNIFICNCE SO IF RIGHT-SKEW IS SIGNIFICANT, EXCLUDE LOWEST P-VALUES
584 | #BUT IF RIGHT SKEW IS N.S., EXCLUEDE HIGHEST P-VALUES
585 | #OR MAYBE DO IT BOTH WAYS ALWAYS
586 |
587 | #If right skew is significant, assess robustness to excluding most significnat finding, one at a time
588 | all.zppr = sort(qnorm(c(t.ppr, f.ppr ,c.ppr, z.ppr )))
589 | all.zppl = sort(qnorm(c(t.ppl, f.ppl ,c.ppl, z.ppl )))
590 | all.zpp33= sort(qnorm(c(t.pp33,f.pp33 ,c.pp33, z.pp33 )))
591 |
592 | droplow.zr=droplow.zl=droplow.z33=drophigh.zr=drophigh.zl=drophigh.z33=c()
593 | for (i in 1:(ktot))
594 | {
595 | droplow.zr[i] =sum(all.zppr[i:ktot]/sqrt(ktot-i+1))
596 | droplow.zl[i] =sum(all.zppl[i:ktot]/sqrt(ktot-i+1))
597 | droplow.z33[i]=sum(all.zpp33[i:ktot]/sqrt(ktot-i+1))
598 |
599 | drophigh.zr[i] =sum(all.zppr[1:(ktot-i+1)]/sqrt(ktot-i+1))
600 | drophigh.zl[i] =sum(all.zppl[1:(ktot-i+1)]/sqrt(ktot-i+1))
601 | drophigh.z33[i]=sum(all.zpp33[1:(ktot-i+1)]/sqrt(ktot-i+1))
602 | }
603 |
604 |
605 |
606 | #19.2 FUNCTION THAT PLOTS RESULTS
607 | plotdrop=function(var)
608 | {
609 | #Plot the dots
610 | plot(0:(ktot-1),pnorm(var),xlab="",ylab="",type="b",yaxt="n",main="",cex.main=1.15,ylim=c(0,1))
611 | #Add marker in results with 0 drops
612 | points(0,pnorm(var[1]),pch=19,cex=1.6)
613 | #Red line at p=.05
614 | abline(h=.05,col="red") #Red line at p=.05
615 | #Y-axis value labels
616 | axis(2,c(.01,.05,.1,seq(from=.2,to=.9,by=.10)),las=1,cex.axis=.95)
617 | }
618 |
619 | #19.3 RUN PLOT FUNCTION 6 TIMES
620 | #Put all graphs together
621 | dev.off()
622 | par(mfrow=c(3,2),mar=c(4,4,1,2),mgp=c(2.5,1,0),oma=c(5,14,5,1))
623 | #Plot(1)
624 | plotdrop(droplow.zr)
625 | mtext(side=2,line=4,"P-value Overall Test",font=2,cex=.85)
626 | mtext(side=2,line=3,"(Stouffer's Method)",font=3,cex=.75)
627 | #Rigt Skew label
628 | mtext("Right Skew",line=8,side = 2,cex=1.2,las=1,col="Blue")
629 | #Low to high label
630 | mtext(bquote("Drop"~italic(k)~bold("lowest")~"original p-values"),line=1,side = 3,cex=1.5,las=1)
631 | #Plot(2)
632 | plotdrop(drophigh.zr)
633 | mtext(bquote("Drop"~italic(k)~bold("highest")~"original p-values"),line=1,side = 3,cex=1.5,las=1)
634 | #Plot (3)
635 | plotdrop(drophigh.z33)
636 | mtext(side=2,line=4,"P-value Overall Test",font=2,cex=.85)
637 | mtext(side=2,line=3,"(Stouffer's Method)",font=3,cex=.75)
638 | #33% Skew label
639 | mtext("33% Power%",line=8,side = 2,cex=1.2,las=1,col="springgreen4")
640 | #Plot (4)
641 | plotdrop(droplow.z33)
642 | #Plot (5)
643 | plotdrop(drophigh.zl)
644 | mtext(side=2,line=4,"P-value Overall Test",font=2,cex=.85)
645 | mtext(side=2,line=3,"(Stouffer's Method)",font=3,cex=.75)
646 | mtext(side=1,line=2.5,"K Tests Dropped From p-curve",cex=1.15,font=2)
647 | #33% Skew label
648 | mtext("Left Skew",line=8,side = 2,cex=1.2,las=1,col="red")
649 | #Plot (6)
650 | plotdrop(droplow.zl)
651 | #x-axis label
652 | mtext(side=1,line=2.5,"K Tests Dropped From p-curve",cex=1.15,font=2)
653 | #Legend (winging it for location)
654 | op=par(usr=c(0,1,0,1),xpd=NA) #allow goin outsie of plot 6 and recalibrate dimensions to be 0-1 in x and y
655 | legend(-.6,-.25,horiz=TRUE,pch=c(19,1),cex=1.4, legend=c("Including all p-values","Dropping p-values"))
656 | #so the legend is placed 60% of a chart to the left of 0 of #6, an 25% of a chart below it.
657 |
658 |
659 |
660 |
661 |
662 |
--------------------------------------------------------------------------------
/original code from others/VadilloHardwickeShanks_effect_sizes edited.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/VadilloHardwickeShanks_effect_sizes edited.xlsx
--------------------------------------------------------------------------------
/original code from others/VadilloHardwickeShanks_effect_sizes.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/VadilloHardwickeShanks_effect_sizes.xlsx
--------------------------------------------------------------------------------
/original code from others/VadilloHardwickeShanks_pcurve_disclosure_table.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/VadilloHardwickeShanks_pcurve_disclosure_table.xlsx
--------------------------------------------------------------------------------
/original code from others/comparisonMoney.R:
--------------------------------------------------------------------------------
1 | library(rio)
2 | dat <- import("VadilloHardwickeShanks_effect_sizes edited.xlsx")
3 |
4 |
5 | dat$id <- 1:nrow(dat)
6 |
7 | plot(dat[, "d"], dat[, "p-checker d"])
8 |
9 | # relative error:
10 | dat$relErr <- dat[, "p-checker d"]/dat[, "d"]
11 |
12 | dat[order(dat$relErr), c("Paper title", "# study", "id", "relErr")]
13 |
14 | dat[47, ]
--------------------------------------------------------------------------------
/original code from others/input_data.csv:
--------------------------------------------------------------------------------
1 | "","line","paper_id","study_id","focal","type","df1","df2","d","g","n.approx","statistic","p.value","p.value.one","p.reported","p.crit","significant","one.tailed","reporting.error","error.direction","parse.error","d.reported","d.reported.str","d.reported.lower","d.reported.upper","d.reported.error","d.reported.error.direction","global.reporting.error","p.value.log","d.var","d.se","studydesign","Z","obs.pow","median.obs.pow","ppr","ppl","pp33"
2 | "1",1,".1","",TRUE,"r",24,NA,0.29088723694137,1.2755127414112,26,0.55,0.00360407531761852,0.00180203765880926,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.62569004111409,0.229390681003584,0.4789474720714,1,2.91088422817956,0.82917756772308,0.82917756772308,0.0720815063523705,0.927918493647629,0.782466903131448
3 | "2",2,".2","",TRUE,"r",21,NA,0.279751442472094,0.971379778043892,23,0.45,0.0311965812500361,0.0155982906250181,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.46744676548987,0.227985180963237,0.477477937671718,1,2.15455617969051,0.577143893186187,0.577143893186187,0.623931625000722,0.376068374999278,0.217796977829189
4 | "3",3,".3","",TRUE,"t",72,NA,0.509371631973611,1.10462840992093,74,4.8,8.35717690715014e-06,4.17858845357507e-06,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-11.6923898784302,0.0708838568298028,0.266240223914049,1,4.45582350015752,0.993717382306396,0.993717382306396,0.000167143538143399,0.999832856461857,0.99613676861413
5 | "4",4,".4","",TRUE,"f",1,40,0.690065559342354,0.677669172048779,42,5,0.0309924607128595,0.0154962303564298,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.47401130688657,0.106575963718821,0.32645974287624,1,2.15716949070589,0.578166639034966,0.578166639034966,0.619849214257191,0.380150785742809,0.213926089890086
6 | "5",5,".5","",TRUE,"f",1,48,0.772528316633119,0.760882161105986,50,7.46,0.00879913945031573,0.00439956972515787,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.73310135201655,0.091936,0.303209498531956,1,2.61976106247763,0.745307970624029,0.745307970624029,0.175982789006315,0.824017210993685,0.604610782657955
7 | "6",6,".6","",TRUE,"t",131,NA,0.274752109736233,0.432829943657599,133,2.51,0.0132910922918141,0.00664554614590705,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.320661220634,0.0314998247498445,0.17748189978092,1,2.47587279602212,0.697040950212269,0.697040950212269,0.265821845836283,0.734178154163717,0.491182666588346
8 | "7",7,".7","",TRUE,"t",131,NA,0.260132990857236,0.387994969414183,133,2.25,0.0261168387751227,0.0130584193875613,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.64517500888438,0.0312199672112612,0.176691729323308,1,2.22446999974079,0.604304984819912,0.604304984819912,0.522336775502454,0.477663224497546,0.273980322296265
9 | "8",8,".8","",TRUE,"t",29,NA,0.529150262212918,0.760475132484101,31,2.17,0.0383397639770765,0.0191698819885383,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.26126769743271,0.148632258064516,0.38552854377402,1,2.07120370007826,0.544286870697626,0.544286870697626,0.766795279541528,0.233204720458472,0.125039608609917
10 | "9",9,".9","",TRUE,"t",40,NA,0.49856938190329,0.790994082847591,42,2.61,0.0126787848554428,0.00633939242772139,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.36782516615488,0.110685034013605,0.332693603806273,1,2.49266656165906,0.702880259048569,0.702880259048569,0.253575697108857,0.746424302891143,0.515629960683949
11 | "10",10,".10","",TRUE,"t",110,NA,0.466368952654441,1.1431776470224,112,6.09,1.69209997088078e-08,8.46049985440388e-09,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-17.8947104000688,0.0475408482142857,0.21803863926902,1,5.64085277918162,0.999883788818096,0.999883788818096,1e-05,0.99999,0.999961882529907
12 | "11",11,".11","",TRUE,"t",94,NA,0.461880215351701,1.03692933932962,96,5.12,1.61818787419967e-06,8.09093937099835e-07,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-13.3342036309887,0.0530444444444444,0.230313795601663,1,4.79605757533483,0.997716546956351,0.997716546956351,3.23637574872748e-05,0.999967636242513,0.998779821611614
13 | "12",12,".12","",TRUE,"f",1,87,0.414349361358778,0.410847817459971,89,3.82,0.0538557154894872,0.0269278577447436,"",0.05,FALSE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-2.92144674378836,0.0468728695871733,0.216501430912531,1,1.92799526215487,0.487248497031451,0.487248497031451,NA,NA,NA
14 | "13",13,".13","",TRUE,"f",1,68,0.636957051703084,0.630108051147137,70,7.1,0.00961854088426485,0.00480927044213242,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.64406270104072,0.0629387755102041,0.250876016211602,1,2.58924938143763,0.735418885034372,0.735418885034372,0.192370817685297,0.807629182314703,0.579411069007791
15 | "14",14,".14","",TRUE,"f",1,71,0.514448767368118,0.50914517182824,73,4.83,0.0312315030469807,0.0156157515234903,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.46632798053978,0.0584199662225558,0.241702226350019,1,2.15411055431263,0.576969441057547,0.576969441057547,0.624630060939615,0.375369939060385,0.207513129149036
16 | "15",15,".15","",TRUE,"f",1,93,0.51789045783427,0.51379106107041,95,6.37,0.0133022084500757,0.00665110422503787,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.31982520866114,0.0449285318559557,0.211963515388747,1,2.47557428865539,0.696936693930562,0.696936693930562,0.266044169001516,0.733955830998484,0.49343168837509
17 | "16",16,".16","",TRUE,"f",1,94,0.436367582052868,0.432949559216945,96,4.57,0.0351308175301616,0.0175654087650808,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.34867654140781,0.0436501736111111,0.208926239642394,1,2.10684730486995,0.558387941216862,0.558387941216862,0.702616350603231,0.297383649396769,0.158270246095359
18 | "17",17,".17","",TRUE,"f",1,101,0.433544882392289,0.430380321206944,103,4.84,0.0300863104415412,0.0150431552207706,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.50368501328798,0.0406598171363936,0.201642795895102,1,2.16895223479203,0.582771294481587,0.582771294481587,0.601726208830824,0.398273791169176,0.221084518497099
19 | "18",18,".18","",TRUE,"f",1,101,0.409119347839599,0.406133075227631,103,4.31,0.0404286253060717,0.0202143126530358,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.20821719773608,0.0404599868036573,0.201146679822604,1,2.04934260505402,0.53560949309077,0.53560949309077,0.808572506121434,0.191427493878566,0.0976569262926101
20 | "19",19,".19","",TRUE,"f",1,195,0.46480168796709,0.463029889918931,197,10.64,0.00130640632273191,0.000653203161365954,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-6.64047517650657,0.0214012213661779,0.146291562867371,1,3.21456873778193,0.895188861450501,0.895188861450501,0.0261281264546387,0.973871873545361,0.8671599879472
21 | "20",20,".20","",TRUE,"f",1,58,0.724798822662767,0.715700929491268,60,7.88,0.00679646396319998,0.00339823198159999,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.99135280746155,0.0754222222222222,0.274631065653946,1,2.70665601217701,0.772375258398578,0.772375258398578,0.135929279264,0.864070720736,0.657123186618878
22 | "21",21,".21","",TRUE,"f",1,164,0.296972677336379,0.295628909565627,166,3.66,0.0574760040131121,0.028738002006556,"",0.05,FALSE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-2.85638773979278,0.0246276672956888,0.156932046745363,1,1.89967331752034,0.475962067532297,0.475962067532297,NA,NA,NA
23 | "22",22,".22","",TRUE,"f",1,106,0.481509970667121,0.478158393145076,108,6.26,0.0138776711900495,0.00693883559502474,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.27747411967712,0.0391838134430727,0.197949017282412,1,2.46041429863165,0.691620983399602,0.691620983399602,0.277553423800989,0.722446576199011,0.48075567089181
24 | "23",23,".23","",TRUE,"f",1,148,0.570847323429537,0.56798832180969,150,12.22,0.000624218847119088,0.000312109423559544,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-7.37900953454452,0.0288391111111111,0.169820820605458,1,3.42086685229699,0.927978950242731,0.927978950242731,0.012484376942381,0.987515623057619,0.917176335624655
25 | "24",24,".24","",TRUE,"f",1,144,0.342032602787897,0.340272572241818,146,4.27,0.0405824480926305,0.0202912240463153,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.20441961883805,0.0281985363107525,0.167924198109601,1,2.04777094977314,0.534984949152145,0.534984949152145,0.811648961852611,0.188351038147389,0.0955611797867638
26 | "25",25,".25","",TRUE,"f",1,57,0.557232872842469,0.550119261699799,59,4.58,0.0366399054451497,0.0183199527225749,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.30661731982501,0.0730594656707843,0.27029514548135,1,2.08975397783224,0.551633709929254,0.551633709929254,0.732798108902994,0.267201891097006,0.141913104513516
27 | "26",26,".26","",TRUE,"f",1,74,0.5419263884757,0.53656078066901,76,5.58,0.0207981732110946,0.0103990866055473,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.87289012252151,0.0564958448753463,0.237688545948992,1,2.31162834511492,0.637455004258161,0.637455004258161,0.415963464221893,0.584036535778107,0.357805981814757
28 | "27",27,".27","",TRUE,"f",1,114,0.50137741307804,0.498128747334554,116,7.29,0.00799037289180683,0.00399518644590341,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.82951785047984,0.0366498216409037,0.191441431359316,1,2.65247633493292,0.755692183679693,0.755692183679693,0.159807457836136,0.840192542163864,0.61702764545556
29 | "28",28,".28","",TRUE,"f",1,52,0.592546294487706,0.584278206657645,54,4.74,0.0340305629599248,0.0170152814799624,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.38049624755812,0.0805761316872428,0.28385935194607,1,2.11970936239737,0.563459173243494,0.563459173243494,0.680611259198498,0.319388740801502,0.173682546013417
30 | "29",29,".29","",TRUE,"f",1,177,0.46365080291002,0.461705414925782,179,9.62,0.00224038070549626,0.00112019035274813,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-6.10110946974555,0.0235473299834587,0.153451392901657,1,3.05636536542108,0.863548420032635,0.863548420032635,0.0448076141099252,0.955192385890075,0.815997368233336
31 | "30",30,".30","",TRUE,"f",1,98,0.435889894354067,0.432612526727345,100,4.75,0.0316941780811593,0.0158470890405797,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.45162227171163,0.0419,0.204694894904587,1,2.14824650515707,0.574672406582344,0.574672406582344,0.633883561623185,0.366116438376815,0.200447965782009
32 | "31",31,".31","",TRUE,"f",1,102,0.591932948385723,0.587653915023899,104,9.11,0.0032110006079154,0.0016055003039577,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.74117267455201,0.0418306213017751,0.204525356134087,1,2.94678144777489,0.838133933958407,0.838133933958407,0.064220012158307,0.935779987841693,0.775208294097308
33 | "32",32,".32","",TRUE,"f",1,210,0.289110542285087,0.288086538003086,212,4.43,0.0365016516870469,0.0182508258435234,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.3103977677176,0.0192621929512282,0.138788302645533,1,2.09129473290601,0.552243165619191,0.552243165619191,0.730033033740938,0.269966966259062,0.140880705340051
34 | "33",33,".33","",TRUE,"f",1,166,0.396112057257491,0.394341064453061,168,6.59,0.0111378993754398,0.00556894968771991,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-4.49740162820277,0.0247434807256236,0.157300606246841,1,2.53834227860733,0.718495627385032,0.718495627385032,0.222757987508797,0.777242012491203,0.537204665768733
35 | "34",34,".34","",TRUE,"f",1,105,0.565024191029551,0.561054466034027,107,8.54,0.00425487784276655,0.00212743892138328,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.45968922647196,0.0403668442658748,0.200915017522023,1,2.85862026791273,0.815582115302661,0.815582115302661,0.0850975568553314,0.914902443144669,0.734133155930902
36 | "35",35,".35","",TRUE,"f",1,136,0.341777111876876,0.339916256458309,138,4.03,0.0466794181908717,0.0233397090954358,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.06445193541884,0.029831968073934,0.17271933323729,1,1.98919740541028,0.511660786691341,0.511660786691341,0.933588363817432,0.0664116361825675,0.0322880907323393
37 | "36",36,".36","",TRUE,"f",1,40,0.672592709134549,0.660510205377641,42,4.75,0.0352452734776854,0.0176226367388427,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-3.34542384445358,0.106009070294785,0.325590341218508,1,2.10552914035412,0.55786766171974,0.55786766171974,0.704905469553707,0.295094530446293,0.16020561030283
38 | "37",37,".37","",TRUE,"f",1,33,1.00740118267607,0.985658711107521,35,8.88,0.00537703944999096,0.00268851972499548,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.22561734437828,0.143281632653061,0.378525603695524,1,2.78353298645071,0.794907752419558,0.794907752419558,0.10754078899982,0.89245921100018,0.711103035779388
39 | "38",38,".38","",TRUE,"f",1,87,0.670066238550297,0.664403706956914,89,9.99,0.00216609583598695,0.00108304791799348,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-6.13482888577413,0.0499886377982578,0.223581389650968,1,3.06646028266952,0.865744117290527,0.865744117290527,0.0433219167197407,0.956678083280259,0.824033629578809
40 | "39",39,".39","",TRUE,"f",1,38,0.924121204171834,0.906684955036516,40,8.54,0.00582192175893804,0.00291096087946902,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.14612487261228,0.12135,0.348353268967007,1,2.75764594685673,0.787472463058218,0.787472463058218,0.116438435178761,0.883561564821239,0.693749551672917
41 | "40",40,".40","",TRUE,"f",1,64,0.722369837284325,0.714129877163211,66,8.61,0.00463695846776365,0.00231847923388182,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-5.3736966303169,0.0685123966942149,0.261748728161599,1,2.83122847836673,0.808195123717305,0.808195123717305,0.0927391693552737,0.907260830644726,0.725150196897885
42 | "41",41,".41","",TRUE,"t",112,NA,0.262244027242874,0.364720924042398,114,1.96,0.0524797674224698,0.0262398837112349,"",0.05,FALSE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-2.9473275660926,0.0362701138811942,0.190447141961212,1,1.93917717912819,0.491707861611144,0.491707861611144,NA,NA,NA
43 | "42",42,".42","",TRUE,"t",119,NA,0.336240763798308,0.617955957086392,121,3.42,0.000858512387186752,0.000429256193593376,"",0.05,TRUE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-7.06030944885868,0.0362533706714022,0.190403179257601,1,3.33320636606345,0.915161495880609,0.915161495880609,0.0171702477437341,0.982829752256266,0.899501014219001
44 | "43",43,".43","",TRUE,"t",44,NA,0.40108548367822,0.536592037153888,46,1.85,0.0710363047415143,0.0355181523707572,"",0.05,FALSE,FALSE,NA,"",FALSE,NA,"",NA,NA,NA,"",FALSE,-2.64456419824018,0.0934262759924386,0.3056571216125,1,1.8052453022587,0.438521550508933,0.438521550508933,NA,NA,NA
45 |
--------------------------------------------------------------------------------
/original code from others/oldParser.R:
--------------------------------------------------------------------------------
1 | # ---------------------------------------------------------------------
2 | # Parser for the ES strings
3 | # - parse test statistics and dfs
4 | # - compute correct p value
5 | # - convert all to ES to Z values
6 | # @param x A string with the effect size. Everything before the colon is an identifier for the paper (can be a number, or the name of the paper). Test statistics with the same identifier belong together. You can also skip that part. By default a critical two-tailed p value of .05 is assumed; to override this for a certain test statistic, write at the end of the line: '; crit = .10', for example. Examples:
7 |
8 | # x = "MMu (2012) S1: t(88)=2.1; crit = .10; p < .04 # comment"
9 | # x = "1: t(88)=2.1, crit = .10, p < .04 # comment"
10 | # x = "1: t(88)=2.1; p < .04; crit = .10"
11 | # x = "Stapel (2008): r(147)=.246"
12 | # x = "F(1,100)=9.1"
13 | # x = "F(2,210)=4.45"
14 | # x = "Z=3.45"
15 | # x = "chi2(1)=9.1"
16 | # x = "r(77)=.47"
17 |
18 |
19 |
20 | # @param round_up: If the t value is reported as 2.1, it could also be 2.1499 which has been rounded down. If you want to be maximally generous, set this parameter to TRUE, and all test statistics are automatically increased by X.XX49.
21 | parse_ES1 <- function(x, paper_id_fallback="_1", round_up=FALSE) {
22 |
23 | library(compute.es)
24 |
25 | W <- c() # W collects all warnings
26 |
27 | # preprocessing: replace typographic characters
28 | x <- gsub("–|−", "-", x)
29 |
30 | # remove everything after a # sign; remove empty rows; convert to lower
31 | x <- gsub("#.*$", "", x)
32 | x <- str_trim(x)
33 |
34 | # replace all commas outside of parentheses with semicolons
35 | if (str_detect(x, "\\)")==TRUE) {
36 | x1 <- str_match(x, "(.*)\\)(.*)")[2]
37 | x2 <- str_match(x, "(.*)\\)(.*)")[3]
38 | x2 <- gsub(",", ";", x2)
39 | x <- paste0(x1, ")", x2)
40 | }
41 |
42 | # Is it only a comment line? Return NULL
43 | if (x == "") return(NULL)
44 |
45 | split0 <- strsplit(x, ":")[[1]]
46 |
47 | # Is a study id provided?
48 | if (length(split0) > 1) {
49 | # separate study id into two parts:
50 | # a) First part until year of publication; b) everything after that
51 | paper_id_full <- as.character(gsub(":", "", split0[1]))
52 | paper_id <- str_match(paper_id_full, "^.*\\(.*\\)")[1]
53 | if (is.na(paper_id)) {
54 | paper_id <- paper_id_full
55 | study_id <- ""
56 | } else {
57 | study_id <- str_trim(str_match(paper_id_full, "\\(.*\\)(.*$)")[2])
58 | }
59 | x2 <- split0[2]
60 | } else {
61 | paper_id <- paper_id_fallback
62 | study_id <- ""
63 | x2 <- split0[1]
64 | }
65 |
66 | split1 <- strsplit(gsub(" ", "", x2), ";")[[1]]
67 |
68 | # define defaults
69 | p.crit <- NA
70 | p.reported <- NA
71 | reporting.error <- NA
72 | error.direction <- ""
73 | one.tailed <- FALSE
74 |
75 | # Is a critical p value and/or reported p value provided? Is it one-tailed?
76 | if (length(split1) > 1) {
77 | for (i in 2:length(split1)) {
78 |
79 | split1[i] <- tolower(split1[i])
80 |
81 | if (str_detect(split1[i], "crit") == TRUE) {
82 | x3 <- strsplit(gsub(" ", "", split1[i]), "=|<|>")[[1]]
83 | p.crit <- suppressWarnings(as.numeric(as.character(x3[2])))
84 | }
85 |
86 | if (str_detect(split1[i], "p\\s*(=|<|>)")==TRUE) {
87 | p.reported <- gsub(" ", "", split1[i])
88 | }
89 |
90 | if (str_detect(split1[i], "one|1t|one-tailed") == TRUE) {
91 | one.tailed <- TRUE
92 | }
93 | }
94 | }
95 |
96 | # set default for p.crit if not defined explicitly
97 | if (is.na(p.crit)) {
98 | p.crit <- ifelse(one.tailed==FALSE, .05, .10)
99 | }
100 |
101 | split2 <- strsplit(split1[1], "=")[[1]]
102 | lhs <- split2[1]
103 | statistic <- suppressWarnings(as.numeric(split2[2]))
104 |
105 | decPlaces <- decplaces(str_trim(split2[2]))
106 |
107 | if (round_up==TRUE) {
108 | statistic <- statistic + sign(statistic)* (4.999 / 10^(decPlaces+1))
109 | }
110 |
111 | # also convert brackets to parentheses
112 | lhs <- gsub("[", "(", lhs, fixed=TRUE)
113 | lhs <- gsub("]", ")", lhs, fixed=TRUE)
114 |
115 | type <- tolower(strsplit(lhs, "(", fixed=TRUE)[[1]][1])
116 | dfs <- str_extract(lhs, "\\(.*\\)")
117 | dfs <- suppressWarnings(as.numeric(strsplit(substring(dfs, 2, nchar(dfs)-1), ",")[[1]])) # remove parentheses
118 |
119 | # error capturing
120 | if (!type %in% c("t", "f", "r", "z", "chi2")) {
121 | W <- c(W, paste0("Test statistic not recognized! ", x))
122 | return(W)
123 | }
124 | if (type != "z" && is.na(as.numeric(dfs[1]))) {
125 | W <- c(W, paste0("Error in df: ", x))
126 | return(W)
127 | }
128 | if (is.na(as.numeric(statistic))) {
129 | W <- c(W, paste0("Error in test statistic: ", x))
130 | return(W)
131 | }
132 |
133 | # compute the actual p values
134 | p.value <- NA
135 | stat <- abs(statistic)
136 | stat.sign <- sign(statistic)
137 | n.approx <- NA # n is approximate because we do not know whether the t-test comes from one sample (n = df+1) or from two samples (n=df+2)
138 | switch(type,
139 | "t" = {
140 | if (length(dfs) != 1) {
141 | W <- c(W, paste0("t values need exactly one df! ", x))
142 | return(W)
143 | }
144 | t.value <- stat
145 | p.value <- pt(t.value, dfs, lower.tail=FALSE)*2
146 | d <- (2*t.value / sqrt(dfs))*stat.sign
147 | g <- d*(1 - (3/(4 * dfs - 1)))
148 | n.approx <- dfs+2
149 | },
150 | "r" = {
151 | if (length(dfs) != 1) {
152 | W <- c(W, paste0("r values need exactly one df (df = n-2)! ", x))
153 | return(W)
154 | }
155 | t.value <- sqrt(dfs) * stat/sqrt(1 - stat^2)
156 | p.value <- pt(t.value, dfs, lower.tail=FALSE)*2
157 | d <- stat.sign*(2*stat) / sqrt(1-stat^2)
158 | g <- d*(1 - (3/(4 * dfs - 1)))
159 | n.approx <- dfs+2
160 | },
161 | "f" = {
162 | if (length(dfs) != 2) {
163 | W <- c(W, paste0("F values need exactly two dfs! ", x))
164 | return(W)
165 | }
166 | #if (dfs[1] != 1) warning("First df of F test should be 1 for a focused test!")
167 | if (dfs[1] == 1) {
168 | t.value <- sqrt(stat)
169 | d <- 2*t.value / sqrt(dfs[2])
170 | g <- d*(1 - (3/(4 * dfs[2] - 1)))
171 | n.approx <- dfs[2]+2
172 | } else {
173 | d <- NA
174 | g <- NA
175 | }
176 | p.value <- pf(stat, dfs[1], dfs[2], lower.tail=FALSE)
177 | },
178 | "z" = {
179 | p.value <- pnorm(stat, lower.tail=FALSE)*2
180 |
181 | # If a number is provided for z it's the sample size
182 | if (!is.na(dfs[1])) {
183 | n <- dfs[1]
184 | d <- (z/sqrt(n))*stat.sign
185 | g <- d*(1 - (3/(4 * n - 1)))
186 | n.approx <- n
187 | } else {
188 | d <- NA
189 | g <- NA
190 | }
191 | },
192 | "chi2" = {
193 | # If two numbers are provided for chi2, the first are the dfs, the second is the sample size
194 | p.value <- pchisq(stat, dfs[1], lower.tail=FALSE)
195 |
196 | if (dfs[1] == 1 & !is.na(dfs[2])) {
197 | # code from compute.es package
198 | n <- dfs[2]
199 | n.approx <- n
200 | dfs <- dfs[1]
201 | r <- sqrt(stat/n)
202 | d <- 2 * r * sqrt((n - 1)/(n * (1 - r^2))) * abs(r)/r
203 | g <- d*(1 - (3/(4 * (n-2) - 1)))
204 | } else {
205 | d <- NA
206 | g <- NA
207 | }
208 | }
209 | )
210 |
211 | # test for reporting errors
212 | # TODO: check both generous *and* non-generous - maybe one of both is correct
213 | # Or better: computer upper and lower bound of p-value: t(47)=2.1 --> from 2.05 to 2.1499
214 | # and check whether the reported p value falls into the interval
215 |
216 | p.actual <- ifelse(one.tailed==FALSE, p.value, p.value/2)
217 | p.reported.num <- suppressWarnings(as.numeric(str_split(p.reported, "=|<|>|<=|>=")[[1]][2]))
218 |
219 | if (!is.na(p.reported) & !is.na(p.reported.num)) {
220 | # check for inequality
221 | if (str_detect(p.reported, "<")) {
222 | if (p.actual >= p.reported.num) {
223 | reporting.error <- TRUE
224 | error.direction <- "smaller"
225 | } else {
226 | reporting.error <- FALSE
227 | error.direction <- ""
228 | }
229 | }
230 |
231 | if (str_detect(p.reported, "<=")) {
232 | if (p.actual >= p.reported.num) {
233 | reporting.error <- TRUE
234 | error.direction <- "smaller"
235 | } else {
236 | reporting.error <- FALSE
237 | error.direction <- ""
238 | }
239 | }
240 |
241 | if (str_detect(p.reported, ">")) {
242 | if (p.actual <= p.reported.num) {
243 | reporting.error <- TRUE
244 | error.direction <- "larger"
245 | } else {
246 | reporting.error <- FALSE
247 | error.direction <- ""
248 | }
249 | }
250 |
251 | if (str_detect(p.reported, "p=")) {
252 |
253 | dec <- decplaces(str_split(p.reported, "=")[[1]][2])
254 | p.actual <- round(p.actual, dec)
255 |
256 | if (p.reported.num == p.actual) {
257 | reporting.error <- FALSE
258 | error.direction <- ""
259 | } else {
260 | reporting.error <- TRUE
261 | error.direction <- ifelse(p.reported.num > p.actual, "larger", "smaller")
262 | }
263 | }
264 |
265 | }
266 |
267 | res <- data.frame(
268 | paper_id = as.character(paper_id),
269 | study_id = as.character(study_id),
270 | focal = ifelse(substr(as.character(paper_id), 1, 1) == "_", FALSE, TRUE),
271 | type = type,
272 | df1 = dfs[1],
273 | df2 = ifelse(length(dfs)>1, dfs[2], NA),
274 | d = d,
275 | g = g,
276 | n.approx = n.approx,
277 | statistic = statistic,
278 | p.value = p.value,
279 | p.value.one = p.value/2,
280 | p.reported = p.reported,
281 | p.crit = p.crit,
282 | significant = p.value < p.crit,
283 | one.tailed = one.tailed,
284 | reporting.error = reporting.error,
285 | error.direction = error.direction
286 | )
287 |
288 | attr(res, "warnings") <- W
289 |
290 | return(res)
291 | }
292 |
293 |
294 |
295 | # A vectorized version of the parse_ES1 function
296 | parse_ES <- function(x, round_up=FALSE) {
297 |
298 | # split input string at line break & remove empty rows
299 | # Preprocessing: remove everything after a # sign; remove empty rows
300 | txt <- str_trim(strsplit(x, "\n")[[1]])
301 | txt <- gsub("#.*$", "", txt)
302 | txt <- str_trim(txt)
303 | txt <- txt[txt != ""]
304 |
305 | if (txt[1]=="" | length(txt)==0) return(NULL)
306 |
307 | res <- data.frame()
308 | Ws <- c()
309 | for (i in 1:length(txt)) {
310 | parsed <- parse_ES1(txt[i], paper_id_fallback = paste0(".", i), round_up=round_up)
311 | if (!is.null(parsed) & is.data.frame(parsed)) res <- rbind(res, parsed)
312 |
313 | # collect errors
314 | if (length(attr(parsed, "warnings")) > 0) Ws <- c(Ws, attr(parsed, "warnings"))
315 | if (is.character(parsed)) Ws <- c(Ws, parsed)
316 | }
317 |
318 | if (nrow(res) == 0) return(NULL)
319 | res2 <- cbind(ID <- 1:nrow(res), res)
320 |
321 | attr(res2, "warnings") <- Ws
322 | return(res2)
323 | }
324 |
325 |
326 |
327 |
--------------------------------------------------------------------------------
/original code from others/old_p_curve_get33.R:
--------------------------------------------------------------------------------
1 | get_33_curve <- function(type, statistic, df, df2, p.crit=.05, power=1/3) {
2 |
3 | # convert r to t values
4 | type <- as.character(type)
5 | statistic[tolower(type)=="r"] <- statistic[tolower(type)=="r"] / sqrt( (1 - statistic[tolower(type)=="r"]^2) / df[tolower(type)=="r"])
6 | type[tolower(type)=="r"] <- "t"
7 |
8 | statistic <- abs(statistic)
9 |
10 | type <- c("f", "f", "f", "t", "r")
11 | statistic <- c(5.1, 6.3, 7.1, 2.3, 0.4)
12 | df <- c(1, 1, 1, 38, 98)
13 | df2 <- c(88, 100, 200, 38, 98)
14 |
15 | ncp <- get_pp_values(type=type, statistic=statistic, df=df, df2=df2, p.crit=.05, power=1/3)$ncp
16 |
17 | res <- data.frame()
18 |
19 | # ---------------------------------------------------------------------
20 | # t-values
21 | # Critical values,xc, for p=.05, .04, .03, .02 and ,01
22 | t.crit <- list()
23 | t.CRIT <- c(.975, .98, .985, .99, .995)
24 | for (j in 1:5)
25 | t.crit[[j]] <- qt(t.CRIT[j], df=df[type=="t"])
26 |
27 | # Probability of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
28 | t.pp <- c()
29 | for (j in 1:5)
30 | t.pp[j] <- mean((1/power)*(pt(t.crit[[j]], df=df[type=="t"], ncp=ncp[ncp$type=="t", "ncp"])-(1-power)))
31 |
32 | t.pp[1] <- 0
33 | t.pp <- c(t.pp, 1)
34 | t.prop <- t.pp[2:6]-t.pp[1:5]
35 |
36 | # ---------------------------------------------------------------------
37 | # F-values
38 | # Critical values,xc, for p=.05, .04, .03, .02 and ,01
39 | f.crit <- list()
40 | f.CRIT <- c(.95, .96, .97, .98, .99)
41 | for (j in 1:5)
42 | f.crit[[j]] <- qf(f.CRIT[j], df1=df[type=="f"], df2=df2[type=="f"])
43 |
44 | # Probability of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
45 | f.pp <- c()
46 | for (j in 1:5)
47 | f.pp[j] <- mean((1/power)*(pf(f.crit[[j]], df1=df[type=="f"], df2=df2[type=="f"], ncp=ncp[ncp$type=="f", "ncp"])-(1-power)))
48 |
49 | f.pp[1] <- 0
50 | f.pp <- c(f.pp, 1)
51 | f.prop <- f.pp[2:6]-f.pp[1:5]
52 |
53 | # ---------------------------------------------------------------------
54 | # chi2-values
55 | # Critical values,xc, for p=.05, .04, .03, .02 and ,01
56 | chi.crit <- list()
57 | chi.CRIT <- c(.95, .96, .97, .98, .99)
58 | for (j in 1:5)
59 | chi.crit[[j]] <- qt(chi.CRIT[j], df=df[type=="chi2"])
60 |
61 | # Probability of a p-value bigger p=.05, .04, .03, .02 and .01 given p<.05 and ncp=ncp33
62 | chi.pp <- c()
63 | for (j in 1:5)
64 | chi.pp[j] <- mean((1/power)*(pchisq(chi.crit[[j]], df=df[type=="chi2"], ncp=ncp[ncp$type=="chi2", "ncp"])-(1-power)))
65 |
66 | chi.pp[1] <- 0
67 | chi.pp <- c(chi.pp, 1)
68 | chi.prop <- chi.pp[2:6]-chi.pp[1:5]
69 |
70 | #TODO: z-values!
71 | }
72 |
--------------------------------------------------------------------------------
/original code from others/p-curve disclosure table.xlsx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/original code from others/p-curve disclosure table.xlsx
--------------------------------------------------------------------------------
/p-checker.Rproj:
--------------------------------------------------------------------------------
1 | Version: 1.0
2 |
3 | RestoreWorkspace: Default
4 | SaveWorkspace: Default
5 | AlwaysSaveHistory: Default
6 |
7 | EnableCodeIndexing: Yes
8 | UseSpacesForTab: Yes
9 | NumSpacesForTab: 2
10 | Encoding: UTF-8
11 |
12 | RnwWeave: Sweave
13 | LaTeX: pdfLaTeX
14 |
--------------------------------------------------------------------------------
/p-curve.R:
--------------------------------------------------------------------------------
1 | # ---------------------------------------------------------------------
2 | # These p-curve functions are partially copied, partially adapted from Uri Simonsohn's (uws@wharton.upenn.edu) original p-curve functions
3 | # http://p-curve.com/Supplement/Rcode_other/R%20Code%20behind%20p-curve%20app%203.0%20-%20distributable.R
4 |
5 |
6 | # ---------------------------------------------------------------------
7 | # p-curve-app 3.0 functions
8 |
9 | # functions that find noncentrality parameter for t,f,chi distributions that gives 33% power for those d.f.
10 |
11 | #t-test
12 | ncp33t <- function(df, power=1/3, p.crit=.05) {
13 | xc = qt(p=1-p.crit/2, df=df)
14 | #Find noncentrality parameter (ncp) that leads 33% power to obtain xc
15 | f = function(delta, pr, x, df) pt(x, df = df, ncp = delta) - (1-power)
16 | out = uniroot(f, c(0, 37.62), x = xc, df = df)
17 | return(out$root)
18 | }
19 |
20 |
21 | ncp33z <- function(power=1/3, p.crit=.05) {
22 | xc = qnorm(p=1-p.crit/2)
23 | #Find noncentrality parameter (ncp) that leads 33% power to obtain xc
24 | f = function(delta, pr, x) pnorm(x, mean = delta) - (1-power)
25 | out = uniroot(f, c(0, 37.62), x = xc)
26 | return(out$root)
27 | }
28 |
29 |
30 | #F-test
31 | ncp33f <- function(df1, df2, power=1/3, p.crit=.05) {
32 | xc=qf(p=1-p.crit,df1=df1,df2=df2)
33 | f = function(delta, pr, x, df1,df2) pf(x, df1 = df1, df2=df2, ncp = delta) - (1-power)
34 | out = uniroot(f, c(0, 37.62), x = xc, df1=df1, df2=df2)
35 | return(out$root)
36 | }
37 |
38 | #chi-square
39 | ncp33chi <- function(df, power=1/3, p.crit=.05) {
40 | xc=qchisq(p=1-p.crit, df=df)
41 | #Find noncentrality parameter (ncp) that leads 33% power to obtain xc
42 | f = function(delta, pr, x, df) pchisq(x, df = df, ncp = delta) - (1-power)
43 | out = uniroot(f, c(0, 37.62), x = xc, df = df)
44 | return(out$root)
45 | }
46 |
47 |
48 | type=c("t", "p")
49 | statistic=c(2.5, 0.01588969)
50 | df=c(48, NA)
51 | df2=c(NA, NA)
52 |
53 |
54 | get_pp_values <- function(type, statistic, df, df2, p.crit=.05, power=1/3) {
55 |
56 | # convert r to t values
57 | type <- as.character(type)
58 | statistic[tolower(type)=="r"] <- statistic[tolower(type)=="r"] / sqrt( (1 - statistic[tolower(type)=="r"]^2) / df[tolower(type)=="r"])
59 | type[tolower(type)=="r"] <- "t"
60 |
61 | statistic <- abs(statistic)
62 |
63 | res <- data.frame()
64 | ncp <- data.frame()
65 | for (i in 1:length(type)) {
66 | switch(tolower(type[i]),
67 | "t" = {
68 | p <- 2*(1-pt(abs(statistic[i]),df=df[i]))
69 | ppr <- p*(1/p.crit) # pp-value for right-skew
70 | ppl <- 1-ppr # pp-value for left-skew
71 | ncp33 <- ncp33t(df[i], power=power, p.crit=p.crit)
72 | pp33 <- (pt(statistic[i], df=df[i], ncp=ncp33)-(1-power))*(1/power)
73 | },
74 | "f" = {
75 | p <- 1-pf(abs(statistic[i]), df1=df[i], df2=df2[i])
76 | ppr <- p*(1/p.crit) # pp-value for right-skew
77 | ppl <- 1-ppr # pp-value for left-skew
78 | ncp33 <- ncp33f(df1=df[i], df2=df2[i], power=power, p.crit=p.crit)
79 | pp33 <- (pf(statistic[i], df1=df[i], df2=df2[i], ncp=ncp33)-(1-power))*(1/power)
80 | },
81 | "z" = {
82 | p <- 2*(1-pnorm(abs(statistic[i])))
83 | ppr <- p*(1/p.crit) # pp-value for right-skew
84 | ppl <- 1-ppr # pp-value for left-skew
85 |
86 | ncp33 <- ncp33z(power=power, p.crit=p.crit)
87 | pp33 <- (pnorm(statistic[i], mean=ncp33, sd=1)-(1-power))*(1/power)
88 | },
89 | "p" = {
90 | p <- statistic[i]
91 | z <- qnorm(p/2, lower.tail=FALSE)
92 | ppr <- p*(1/p.crit) # pp-value for right-skew
93 | ppl <- 1-ppr # pp-value for left-skew
94 |
95 | ncp33 <- ncp33z(power=power, p.crit=p.crit)
96 | pp33 <- (pnorm(z, mean=ncp33, sd=1)-(1-power))*(1/power)
97 | },
98 | "chi2" = {
99 | p <- 1-pchisq(abs(statistic[i]), df=df[i])
100 | ppr <- p*(1/p.crit) # pp-value for right-skew
101 | ppl <- 1-ppr # pp-value for left-skew
102 | ncp33 <- ncp33chi(df[i], power=power, p.crit=p.crit)
103 | pp33 <- (pchisq(statistic[i], df=df[i], ncp=ncp33)-(1-power))*(1/power)
104 | },
105 | {
106 | # default
107 | warning(paste0("Test statistic ", type[i], " not suported by p-curve."))
108 | }
109 | )
110 | res <- rbind(res, data.frame(p=p, ppr=ppr, ppl=ppl, pp33=pp33))
111 | ncp <- rbind(ncp, data.frame(type=type[i], df=df[i], df2=df2[i], ncp=ncp33))
112 | }
113 |
114 | if (nrow(res) > 0) {
115 | # clamp to extreme values
116 | res$ppr <- clamp(res$ppr, MIN=.00001, MAX=.99999)
117 | res$ppl <- clamp(res$ppl, MIN=.00001, MAX=.99999)
118 | res$pp33 <- clamp(res$pp33, MIN=.00001, MAX=.99999)
119 |
120 | # remove non-significant values
121 | res[res$p > p.crit, ] <- NA
122 |
123 | return(list(res=res, ncp=ncp))
124 | } else {
125 | return(NULL)
126 | }
127 | }
128 |
129 |
130 |
131 |
132 |
133 | # ---------------------------------------------------------------------
134 | # New p-curve computation (p-curve app 3.0, http://www.p-curve.com/app3/)
135 | p_curve_3 <- function(pps) {
136 |
137 | pps <- na.omit(pps)
138 |
139 | # STOUFFER: Overall tests aggregating pp-values
140 | ktot <- sum(!is.na(pps$ppr))
141 | Z_ppr <- sum(qnorm(pps$ppr))/sqrt(ktot) # right skew
142 | Z_ppl <- sum(qnorm(pps$ppl))/sqrt(ktot) # left skew
143 | Z_pp33<- sum(qnorm(pps$pp33))/sqrt(ktot) # 33%
144 |
145 | p_ppr <- pnorm(Z_ppr)
146 | p_ppl <- pnorm(Z_ppl)
147 | p_pp33<- pnorm(Z_pp33)
148 |
149 | return(list(
150 | Z_evidence = Z_ppr,
151 | p_evidence = p_ppr,
152 | Z_hack = Z_ppl,
153 | p_hack = p_ppl,
154 | Z_lack = Z_pp33,
155 | p_lack = p_pp33,
156 | inconclusive = ifelse(p_ppr>.05 & p_ppl>.05 & p_pp33>.05, TRUE, FALSE)))
157 | }
158 |
159 |
160 | # ---------------------------------------------------------------------
161 | # Old p-curve computation (p-curve app 2.0, http://www.p-curve.com/app2/)
162 | p_curve_2 <- function(pps) {
163 |
164 | pps <- na.omit(pps)
165 |
166 | df <- 2*sum(nrow(pps))
167 |
168 | chi2_evidence <- -2*sum(log(pps$ppr), na.rm=TRUE)
169 | p_evidence <- pchisq(chi2_evidence, df=df, lower.tail=FALSE)
170 |
171 | chi2_hack <- -2*sum(log(pps$ppl), na.rm=TRUE)
172 | p_hack <- pchisq(chi2_hack, df=df, lower.tail=FALSE)
173 |
174 | chi2_lack <- -2*sum(log(pps$pp33), na.rm=TRUE)
175 | p_lack <- pchisq(chi2_lack, df=df, lower.tail=FALSE)
176 |
177 | return(list(
178 | chi2_evidence = chi2_evidence,
179 | p_evidence = p_evidence,
180 | chi2_hack = chi2_hack,
181 | p_hack = p_hack,
182 | chi2_lack = chi2_lack,
183 | p_lack = p_lack,
184 | df = df,
185 | inconclusive = ifelse(p_evidence>.05 & p_hack>.05 & p_lack>.05, TRUE, FALSE)))
186 | }
187 |
188 |
189 |
190 | theoretical_power_curve <- function(power=1/3, p.max=.05, normalize=TRUE) {
191 | # compute arbitrary test statistics for requested power
192 | library(pwr)
193 | d <- 0.2
194 | n <- pwr.t.test(d=0.2, power=power)$n*2
195 |
196 | crit <- seq(0.01, p.max, by=.01)
197 | pdens <- c()
198 | for (cr in crit) {
199 | pdens <- c(pdens, pwr.t.test(d=0.2, power=NULL, n=n/2, sig.level=cr)$power)
200 | }
201 | p.dens <- diff(c(0, pdens))
202 | if (normalize == TRUE) p.dens <- p.dens/sum(p.dens)
203 |
204 | names(p.dens) <- as.character(crit)
205 | return(p.dens)
206 | }
--------------------------------------------------------------------------------
/pancollapse.R:
--------------------------------------------------------------------------------
1 | library(shiny)
2 | library(xtable)
3 | library(htmltools)
4 | library(utils)
5 |
6 | pancollapse <- function(){
7 | tags$head(tags$link(rel="stylesheet", type="text/css", href="pancollapse.css"),
8 | tags$script(src="pancollapse.js"))
9 | }
10 |
11 | alert.create <- function(content, style="info") {
12 | HTML(paste0(''),
13 | '×
'
16 | )
17 | }
18 |
19 | pancollapse.create <- function(title, content, class="panel-default"){
20 | HTML('
',
21 | title,
22 | ' ',
23 | content,
24 | '
',
30 | title,
31 | ' ',
32 | content,
33 | '
', htmlEscape(names(df)), ' ', collapse='')
39 |
40 | tbody <- rep("",nrow(df))
41 |
42 | for(row in 1:nrow(df)) {
43 | format <- '%s '
44 |
45 | tbody[row] <- paste0(sapply(df[row,], function(x){ sprintf('%s ', htmlEscape(as.character(x))) }), collapse='');
46 |
47 | cls <- NULL
48 | if( is.function(cbGetClass) ) {
49 | cls <- cbGetClass(df[row,])
50 | }
51 |
52 | if(is.character(cls)) {
53 | tbody[row] <- sprintf('%s ', htmlEscape(cls), tbody[row])
54 | } else {
55 | tbody[row] <- sprintf('%s ', tbody[row])
56 | }
57 | }
58 |
59 | tbody2 <- paste0(tbody, collapse='')
60 |
61 | HTML(
62 | '',
63 | thead,
64 | ' ',
65 | tbody2,
66 | '
About
2 | (c) 2018 by Felix Schönbrodt (www.nicebread.de ).
3 |
4 | Citation
5 | Programming this app took a considerable effort and amount of time. If you use it in your research, please consider citing the app, and of course the creators of the statistical tests:
6 | p-checker: One-for-all p-value analyzer. Retrieved from http://shinyapps.org/apps/p-checker/.
8 |
9 |
10 | The source code of this app is licensed under the open GPL-2 license and is published on Github .
11 | p-curve (Simonsohn, Nelson, & Simmons, 2014; see http://www.p-curve.com ) in its previous ("app2") and the current version ("app3"), the R-Index and the Test of Insufficient Variance, TIVA (Schimmack, 2014; see http://www.r-index.org/ ), and tests whether p values are reported correctlyhere ). TIVA code adapted from Moritz Heene; original fasterParser and several GUI functions by Tobias Kächele.
16 | Citation of tests
19 | Programming this app took a considerable effort and amount of time. If you use it in your research, please consider citing the app, and of course the creators of the statistical tests:
20 | p-checker: One-for-all p-value analyzer. Retrieved from http://shinyapps.org/apps/p-checker/.
26 | Quantifying Statistical Research Integrity: The Replicability-Index . Retrieved from http://www.r-index.org
28 | Journal of Experimental Psychology: General, 143 , 534–547. doi:10.1037/a0033242
30 | Research Synthesis Methods, 5 , 60–78. doi:10.1002/jrsm.1095
32 | Disclaimer / Validity of the results
37 | I cross-validated the results with p-curve.com and did not find differences (unsurprisingly, as I use Uri's code for p-curve to a large extent). With a single click (see the "Export" tab) you can transfer the test statistics to p-curve.com and cross-validate the results yourself.
38 | I also checked the results with the R-Index Excel-sheet and did not find differences so far.
39 | source code and check the validity yourself. If you suspect a bug or encounter errors, please send me an email with your test statistics and a description of the error.
40 |
41 | Comments
42 | Any detected bugs, comments, and feature requests are welcome: felix@nicebread.de
43 | https://osf.io/3urp2/
46 |
47 |
48 |
49 | Simonsohn, U., Nelson, L. D., & Simmons, J. P. (2014). P-curve: A key to the file-drawer. Journal of Experimental Psychology: General, 143 , 534–547. doi:10.1037/a0033242
50 | Perspectives on Psychological Science, 6 , 291–298. doi:10.1177/1745691611406923
52 |
55 |
--------------------------------------------------------------------------------
/snippets/demo_syntax.txt:
--------------------------------------------------------------------------------
1 | #' @title Demo data
2 | #' @subtitle by Slartibartfast
3 | #' @details Go and replace the examples in the text box! # starts a comment
4 | #' @url http://shinyapps.org/apps/p-checker/
5 |
6 | # Each line is one test statistic
7 | # Easy mode: only enter the test statistics with df
8 | t(47) = 2.1
9 | chi2(1) = 9.15
10 | r(77) = .47
11 | F(1, 88) = 9.21
12 | p = .02
13 | p(48) = .018
14 |
15 | # add reported p-value; mark one-tailed; set alpha level
16 | t(123) = 2.54; p < .01
17 | Z = 1.9; one-tailed; p=.03
18 | r(25) = 0.21; crit=.10
19 |
20 | # add paper ID
21 | A&B (2001) Study1: t(88)=2.1; one-tailed; p < .02
22 | A&B (2001) Study1: r(147)=.246
23 | A&B (2001) Study2: F(1,100)=9.1
24 | CD&E (2014) S1a: F(1,210)=4.45; p < .01
25 | CD&E (2014) S1b: t(123)=2.01; one-tailed; p = .02
26 |
--------------------------------------------------------------------------------
/snippets/extended_manual.html:
--------------------------------------------------------------------------------
1 |
2 | Manual
3 |
4 |
5 |
6 | All p-values can be extracted, both from focal hypothesis tests and from ancillary analyses, such as manipulation checks. But only p values are extracted for which precise dfs are reported (i.e., results such as “Fs < 1, ps > .50” are not extracted).Format:
8 |
9 | Study ID: teststatistic ; [optional] reported p value; [optional]
10 | critical p value; [optional, if one-tailed testing] one-tailed
11 |
12 | [optional] reported p value: e.g., p = .03, or p < .05
13 | [optional] critical p value: e.g., crit = .10, or crit = .08
14 | [optional, if one-tailed testing]: write the keyword one-tailed, or just one, or 1t
15 |
16 | The colon separates study ID from everything else
17 | If the study ID starts with an underscore, this test statistic is not a focal test (e.g., from a manipulation check, a pre-test, or an ancillary analysis for possible alternative explanations), and will not be included in R-Index or p-curve analyses (but it will be included in the test for correct p-values)
18 | The first datum after the colon must be the test statistic
19 | All optional informations are separated by semicolons; can be given in any order
20 | At the end of a line a comment can be written after a # sign (everything after the # is ignored)
21 |
22 | Examples:
23 |
24 | M&E (2005) S1: t(25) = 2.1; p < .05; one-tailed
25 | M&E (2005) S2: F(1, 45) = 4.56; p = .03 # wrong p value?
26 | M&E (2005) S3: chi2(1) = 3.7; crit=.10
27 | _M&X (2011) S1: r(123) = .08; p = .45 # this was a manipulation check (see underscore)
28 |
29 | Be careful if you copy & paste the results from a PDF:
30 |
31 | Sometimes there are invisible special characters. They are shown in the app as weird signs and must be removed.
32 | The minus sign sometimes looks a bit longer (an “em-dash”). This should be replaced with a standard minus sign.
33 |
34 | Which tests to select in the presence of interactions ? Some hints from Simonsohn et al.’s (2014) p-curve paper:
35 |
36 | “When the researcher’s stated hypothesis is that the interaction attenuates the impact of X on Y (e.g., people always sweat more in summer, but less so indoors), the relevant test is whether the interaction is significant (Gelman & Stern, 2006), and hence p-curve must include only the interaction’s p-value. […] Simple effects from a study examining the attenuation of an effect should not be included in p-curve, as they bias p-curve to conclude evidential value is present even when it is not.”
37 | “When the researcher’s stated hypothesis is that the interaction reverses the impact of X on Y (e.g., people sweat more outdoors in the summer, but more indoors in the winter), the relevant test is whether the two simple effects of X on Y are of opposite sign and are significant, and so both simple effects’ p-values ought to go into p-curve. The interaction that is predicted to reverse the sign of an effect should not be included in p-curve, as it biases p-curve to conclude evidential value is present even when it is not.”
38 |
39 |
40 |
41 | Sign of effects
42 | You can provide the sign of a test statistic (e.g., t(123) = -2.8). This, however, is ignored in R-index, TIVA, and p -curve, which only use the p -values and ignore the sign. Hence, for these analyses by now it is implicitly assumed that all effects go into the predicted direction. Special cases
47 |
48 |
49 | Significant studies are used to determine the success rate in the R-index analyses. But sometimes marginally non-significant p values (e.g., p = .051) are falsely rounded downwards and cross the critical boundary only due to this error (i.e., they are reported as “p < .05)”). In this case, the ES does not count for a "success" (see column “significant” in the R-Index tab), as the actual p -value is not significant. But, if the ES has been (falsely) interpreted as significant by the original authors, the critical value can be slightly increased, so that the ES is also counted as a success in the R-Index analysis. In this case, increase the critical level to crit = .055 for example. This decision (whether "near significant" studies, that are falsely interpreted as significant, should be included as "successes" in the R-index analysis) should be made a priori.
50 |
51 |
52 |
53 | Reproducible Analyses
54 |
55 |
57 |
58 | Copy the link below the text entry area for a reproducible analysis. This way you can share any p-value analysis in a single link!
59 |
60 | Roxygen-style header for your analysis
61 | You can add title, subtitle, details, and an URL for your analysis in the syntax:
62 |
64 | #' @title The title of your analysis
69 |
70 |
71 | Technical Details
72 |
73 | The Egger's test and PET-PEESE are implemented as:
74 |
76 | PET <- lm(d~d.se, data, weight=1/d.var)
--------------------------------------------------------------------------------
/snippets/quick_start.html:
--------------------------------------------------------------------------------
1 | Quick Start
2 | Enter test statistics in the text field on the left. You can just enter the plain statistics (see the first four lines of the example), or you can add additional information:
4 | Everything before a colon is an identifier for the paper. For optimal parsing, it should have the format XXXX (YYYY) ZZ. Everything before the year in parenthesis (i.e., XXXX) is an ID for the paper. Everything after the year is an ID for the study within that paper. Example: AB&C (2013) Study1. Test statistics with the same paper and study ID belong together (this is relevant for the R-Index).
5 |
6 | By default a critical two-tailed p value of .05 is assumed; for one-tailed tests you can add ; one-tailed (or shorter: ; 1t) to set the critical p-value to .10
7 |
8 | You can also directly define the critical p: ; crit = .10, for example.
9 |
10 | You can check whether a p value has been correctly reported when you provide the reported p value, for example p < .05, or p = .037.
11 |
12 | In general, all options should be written after the test statistic and be separated by semicolons, e.g. A&B (2001) Study1: t(88)=2.1; one-tailed; p < .02.
13 |
14 |
18 | t-values: t(45)=3.4
19 | F-values: F(1, 25)=4.4
20 | Z-values: Z=2.02
21 | chi2-values: chi2(1)=2.4
22 | r-values: r(188)=0.276
23 |
24 |
25 |
26 | The numbers in the brackets generally are degrees of freedom. In the case of correlations (r-values), the df often are not explicitly provided in the results sections; they are N-2.
27 | chi2(1, 326) = 3.8)
29 | z -values and p -values, the number in parentheses is the sample size (e.g., p(52) = 0.02)
--------------------------------------------------------------------------------
/snippets/responsibly.html:
--------------------------------------------------------------------------------
1 |
2 | Terms of Use
3 | Have fun playing around with p-checker! This web application provides several tests for publication bias/p-hacking/indicators for data-dependent analyses, whatever term you prefer. Some of them are new, unpublished, and controversial to some extent; purpose of this app is to provide a unified place for trying out and comparing these methods. Please use the tests with care.
4 |
7 | It is not OK to search for single papers which score low on a certain index ("cherry-picking"), and to single out these papers. Sampling variation applies to papers as well, and it can occur by chance that some rare combinations of results are found.
8 | Always analyze papers with a defendable a priori inclusion criterion, e.g.: "All papers from an certain journal issue, which have more than 2 studies", or "The 10 most cited papers of a working group".
9 | Disclose the inclusion rule.
10 | Take care what p-values can be included. p-curve, for example, assumes the independence of p-values. That means, you usually only extract one p-value per sample.
11 | In general: RTFM of the tests you do!
12 |
13 | p-curve paper . They have sensible recommendations and rules of thumb which papers and test statistics to include in an analysis.
--------------------------------------------------------------------------------
/snippets/version_history.html:
--------------------------------------------------------------------------------
1 | Release notes / Version history
2 |
3 | Version 0.7 (2018-01-15)
4 |
5 | Changes:
6 |
8 |
9 | Added PET-PEESE and Egger's test. Renamed tab to "Meta-Analysis".
10 | PLEASE read the disclaimer on top of the meta-analysis tab: The test statistics are converted to Cohen's d wherever possible, based on the formulas provided by Borenstein, Hedges, Higgins, & Rothstein (2011). Warning: These effect size conversions are based on approximative formulas; furthermore the app always assumes equal cell sizes and other simplifications. Although these proxies work good under many conditions, this quick meta-analytic overview cannot replace a proper meta-analysis! For the same reasons, the results here might slightly differ from published results from a proper meta-analysis.
13 |
14 | Fixed some signs and one-tailed stats in the glucose demo data.
15 |
16 |
17 | Removed "Export" tab (the export link now is below the text entry field on the left side).
18 |
19 |
20 | Slightly updated design
21 |
22 |
23 | Fixed a bug in TIVA: p-values are now one-tailed (as it should be). Thanks to Aurelien Allard and Katie Corker for reporting the bug.
24 |
25 |
26 |
27 | Version 0.6.2 (2016-10-04)
28 |
29 | Changes:
30 |
32 |
33 | Changed TIVA computation to log(p), which allows much smaller p-values (thanks to Rickard Carlsson @RickCarlsson for pointing out the bug).
34 |
35 |
36 | Added power posing p-curve data from Joe Simmons and Uri Simonsohn (see http://datacolada.org/37 )
37 |
38 |
39 |
40 | Version 0.6.1 (2016-06-14)
41 |
42 | Changes:
43 |
45 | New "test statistic": You can now directly enter p-values (optionally with df in parentheses), based on a suggestion by Roger Giner-Sorolla. If df are provided, an effect size is computed based on a approximative conversion formula by (see here ).
46 |
47 |
48 | p=.034
49 | p(48)=.024
50 |
51 |
52 |
53 |
54 | Version 0.6 (2016-02-22)
55 |
56 | Changes:
57 |
59 | Added 33% (or other) theoretical p-curve in plot
60 | Moved comparison-power-slider to standard controls
61 |
62 |
63 |
64 | Version 0.5 (2016-02-15)
65 |
66 | Changes:
67 |
69 | Included Begg's test for publication bias
70 | Fixed bug in effect size plot
71 | "Send to p-curve" now links to app4
72 | Much improved parser (at least 100x faster)
73 |
74 |
75 | Known issues:
76 |
77 | TODO code clean-up: Clearly separate the inference functions from UI functions
78 |
--------------------------------------------------------------------------------
/tests.R:
--------------------------------------------------------------------------------
1 | x = "1: t(88)=2.1; crit = .10"
2 | x = "r(147)=.246"
3 | x = "F(1,100)=9.1"
4 | x = "f(2,210)=4.45"
5 | x = "Z=3.45"
6 | x = "chi2(1)=9.1"
7 | x = "r(77)=.47"
8 |
9 | parse_ES1("3: t(88)=2.1; crit = .10; p < .04", round_up=TRUE)
10 | parse_ES1("r(147)=.246")
11 | parse_ES1("test: F(1,100)=9.1")
12 | parse_ES1("f(2,210)=4.45")
13 | parse_ES1("Z=3.45")
14 | parse_ES1("chi2(1)=9.1")
15 | parse_ES1("r(77)=.47")
16 |
17 |
18 | x <- c("
19 | a1: t(88)=2.1; crit=.10
20 | a1: r(147)=.246
21 | a1: F(1,100)=9.1; crit = .08
22 | f(2,210)=4.45
23 | Z=3.45
24 | chi2(1)=9.1
25 | r(77)=.47")
26 |
27 |
28 | x <- c("
29 | t(88)=2.1
30 | r(147)=.246
31 | F(1,100)=9.1
32 | f(2,210)=4.45
33 | Z=3.45
34 | chi2(1)=9.1
35 | r(77)=.47
36 | chi2(2)=8.74
37 | ")
38 |
39 | tbl2 <- parse_ES(txt)
40 |
41 |
42 | # Test wrong syntax
43 |
44 | parse_ES1("3: t(88, 2)=2.1; crit = .10; p < .04", round_up=TRUE)
45 | r <- parse_ES("3: t(88, 2)=2.1; crit = .10; p < .04")
46 | attr(r, "warnings")
47 |
--------------------------------------------------------------------------------
/tests/Dunlap paired t-tests.R:
--------------------------------------------------------------------------------
1 | library(effsize)
2 |
3 | x <- c(27, 25, 30, 29, 30, 33, 31, 35)
4 | y <- c(21, 25, 23, 26, 27, 26, 29, 31)
5 | D <- x-y
6 |
7 | t.test(D, mu=0)
8 | t.test(x, y)
9 | t.test(x, y, paired=TRUE)
10 |
11 | cohen.d(x,y)
12 | tes(t.test(x, y)$statistic, length(x), length(y))
13 |
14 | cohen.d(x,y, paired=TRUE)
15 |
16 | # t(14)=2.530
17 | # t(7) = 4.513
18 | # t(7) = 4.513
--------------------------------------------------------------------------------
/ui.R:
--------------------------------------------------------------------------------
1 | library(shiny)
2 | library(shinyjs)
3 | library(shinythemes)
4 | library(shinyBS) # Additional Bootstrap Controls
5 | #library(ggvis)
6 |
7 | # Load the panels with the manual etc.
8 | source("pancollapse.R")
9 |
10 | # custom js function to open external URL
11 | jsCode <- "shinyjs.browseURL = function(URL){window.open(URL, ''); ;}"
12 |
13 | shinyUI(tagList(
14 |
15 | # https://github.com/daattali/shinyjs#using-shinyjs-with-navbarpage-layout
16 | useShinyjs(),
17 | extendShinyjs(text = jsCode, functions=c("browseURL")),
18 |
19 | navbarPage(title="",
20 | tabPanel("p-checker",
21 | # ---------------------------------------------------------------------
22 | # The actual app ...
23 | HTML("p -checkerp -value analyzerNew feature: You can now enter p -values directly (e.g. p=0.021). If you provide the sample size in addition (e.g. p(48)=.03), the p -value is also converted into an effect size.', style="success"),
111 |
112 | alert.create("Disclaimer: This web application provides several tests for publication bias/p-hacking/indicators for data-dependent analyses. Some of them are new, unpublished, and controversial to some extent; purpose of this app is to provide a unified place for trying out and comparing these methods. Please use the tests with care, and RTM of the tests. (You can dismiss this message by clicking 'X')", style="info"),
113 |
114 | # show ROxygen-style title if provided in the syntax
115 | htmlOutput("roxygen_title"),
116 |
117 | # show warning if experimental features are activated
118 | htmlOutput("experimental_features_warning"),
119 |
120 | # show potential parser errors on top of output
121 | htmlOutput("parser_errors"),
122 |
123 | tabsetPanel(id ="tabs1",
124 | tabPanel("Excess Significance",
125 | htmlOutput("rindex_summary"),
126 | conditionalPanel(
127 | condition = "input.group_by_paper == 1",
128 | downloadButton('downloadRIndex','Save R-Index results as CSV file', class="btn-sm")
129 | ),
130 | HTML('For information about R-Index, see https://replicationindex.com . '),
131 | htmlOutput("rindex_table")
132 | ),
133 | tabPanel("TIVA",
134 | alert.create('The TIVA test expects that all entered test statistics/p-values are in the expected direction (regardless of the sign). Please delete or comment out all rows with results in the "wrong" direction.'),
135 | htmlOutput("tiva_summary"),
136 | conditionalPanel(
137 | condition = "input.group_by_paper == 1",
138 | downloadButton('downloadTIVA','Save TIVA results as CSV file', class="btn-sm")
139 | ),
140 | HTML('For information about TIVA, see replicationindex.wordpress.com . '),
141 | htmlOutput("tiva_table")
142 | ),
143 | tabPanel("p-Curve",
144 | conditionalPanel(
145 | condition = "input.group_by_paper == 0",
146 | htmlOutput("pcurve_plot")
147 | ),
148 | htmlOutput("pcurve_summary"),
149 | conditionalPanel(
150 | condition = "input.group_by_paper == 1",
151 | downloadButton('downloadPCurve','Save p-curve results as CSV file', class="btn-sm")
152 | ),
153 | HTML('For information about p-curve, see http://p-curve.com/ .Journal of Experimental Psychology: General, 143 , 534–547. doi:10.1037/a0033242
155 | '),
156 | tableOutput("pcurve_table")
157 | ),
158 | tabPanel("Meta-analysis",
159 | br(),
160 | alert.create('The test statistics are converted to Cohen\'s d wherever possible, based on the formulas provided by Borenstein, Hedges, Higgins, & Rothstein (2011). Warning: These effect size conversions are based on approximative formulas; furthermore the app always assumes equal cell sizes and other simplifications. Although these proxies work good under many conditions, this quick meta-analytic overview cannot replace a proper meta-analysis!'),
161 | #ggvisOutput("ES_plot"),
162 | # show potential parser errors on top of output
163 | htmlOutput("MA_warnings"),
164 | htmlOutput("effectsizes")
165 |
166 | ),
167 | # tabPanel("Research style analysis (beta)",
168 | # htmlOutput("researchstyle")
169 | # ),
170 | tabPanel("p values correct?",
171 | htmlOutput("report_table")
172 | )#,
173 | # tabPanel("Export",
174 | # tableOutput("export")
175 | # )#,
176 | #tabPanel("Demo data",
177 | # htmlOutput("demodata")
178 | #)
179 | )
180 | )
181 | )
182 | ),
183 | tabPanel('Quick Start', loadHTML('snippets/quick_start.html')),
184 | tabPanel('Manual', loadHTML('snippets/extended_manual.html')),
185 | tabPanel('Terms of Use', loadHTML('snippets/responsibly.html')),
186 | tabPanel('About', loadHTML('snippets/about.html')),
187 | tabPanel('Release Notes', loadHTML('snippets/version_history.html')),
188 | header = pancollapse(),
189 | theme = shinytheme("spacelab"),
190 | # load custom css to override some theme settings
191 | tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "p-checker-theme.css")),
192 | windowTitle = "One-for-all p-value analyzer"
193 | )))
194 |
--------------------------------------------------------------------------------
/www/accordion.css:
--------------------------------------------------------------------------------
1 | @import url('//netdna.bootstrapcdn.com/font-awesome/3.2.1/css/font-awesome.css');
2 |
3 | /* CSS Method for adding Font Awesome Chevron Icons */
4 | .accordion-toggle:after {
5 | /* symbol for "opening" panels */
6 | font-family:'FontAwesome';
7 | content:"\f077";
8 | float: right;
9 | color: inherit;
10 | }
11 | .panel-heading.collapsed .accordion-toggle:after {
12 | /* symbol for "collapsed" panels */
13 | content:"\f078";
14 | }
--------------------------------------------------------------------------------
/www/busy.css:
--------------------------------------------------------------------------------
1 | div.busy {
2 | position:absolute;
3 | top: 40%;
4 | left: 50%;
5 | margin-top: -100px;
6 | margin-left: -50px;
7 | display:none;
8 | background: rgba(230, 230, 230, .8);
9 | text-align: center;
10 | padding-top: 20px;
11 | padding-left: 30px;
12 | padding-bottom: 40px;
13 | padding-right: 30px;
14 | border-radius: 5px;
15 | }
--------------------------------------------------------------------------------
/www/busy.js:
--------------------------------------------------------------------------------
1 | setInterval(function() {
2 | if ($('html').attr('class')=='shiny-busy') {
3 | setTimeout(function() {
4 | if ($('html').attr('class')=='shiny-busy') {
5 | $('div.busy').show()
6 | }
7 | }, 1000)
8 | } else {
9 | $('div.busy').hide()
10 | }
11 | }, 100)
12 |
--------------------------------------------------------------------------------
/www/demo-pics/powerposing.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/www/demo-pics/powerposing.jpg
--------------------------------------------------------------------------------
/www/loading.css:
--------------------------------------------------------------------------------
1 | div.loading {
2 | position:absolute;
3 | top: 40%;
4 | left: 50%;
5 | margin-top: -100px;
6 | margin-left: -50px;
7 | display:none;
8 | background: rgba(230, 230, 230, .8);
9 | text-align: center;
10 | padding-top: 20px;
11 | padding-left: 30px;
12 | padding-bottom: 40px;
13 | padding-right: 30px;
14 | border-radius: 5px;
15 | }
16 |
--------------------------------------------------------------------------------
/www/p-checker-theme.css:
--------------------------------------------------------------------------------
1 | #leftCol {
2 | background-color: #fafafa;
3 | padding: 10px;
4 | }
--------------------------------------------------------------------------------
/www/pancollapse.css:
--------------------------------------------------------------------------------
1 | .panel-heading-collapse {
2 | cursor: pointer;
3 | }
--------------------------------------------------------------------------------
/www/pancollapse.js:
--------------------------------------------------------------------------------
1 | $(document).on('click', '.panel-heading-collapse', function(e){
2 | var panel = $(this).parents('.panel');
3 | var panelBody = panel.find('.panel-body');
4 | if(!panelBody.hasClass('panel-collapse')) {
5 | panelBody.slideUp();
6 | panelBody.addClass('panel-collapse collapse');
7 | } else {
8 | panelBody.slideDown();
9 | panelBody.removeClass('panel-collapse collapse');
10 | }
11 | panel.find('i').toggleClass('glyphicon-chevron-up glyphicon-chevron-down');
12 | });
--------------------------------------------------------------------------------
/www/preloader.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/nicebread/p-checker/636cd92036dcaa5f6761dd23ba08ffe064d02eaf/www/preloader.gif
--------------------------------------------------------------------------------
/www/showstartmessage.js:
--------------------------------------------------------------------------------
1 | $(document).ready(
2 | function(){
3 | $('div.loading').show();
4 | });
5 |
--------------------------------------------------------------------------------