if(!require(nortest)){install.packages('nortest')} #normality tests library(nortest) if(!require(VGAM)){install.packages('VGAM')} #probit transformation library(VGAM) if(!require(devtools)){install.packages('devtools')} #RPP functions library(devtools) source_url('https://raw.githubusercontent.com/FredHasselman/toolboxR/master/C-3PR.R') in.IT(c('ggplot2','RColorBrewer','lattice','gridExtra','plyr','dplyr','httr','extrafont')) #get raw data from OSF website info <- GET('https://osf.io/fgjvw/?action=download', write_disk('rpp_data.csv', overwrite = TRUE)) #downloads data file from the OSF RPPdata <- read.csv("rpp_data.csv")[1:167, ] colnames(RPPdata)[1] <- "ID" # Change first column name to ID to be able to load #prepare IDs for internally replicated effects and non-internally replicated effects #for studies with r reported idIntRepl_r <- RPPdata$ID[!is.na(RPPdata$T_r..O.) & !is.na(RPPdata$T_r..R.) & RPPdata$Successful.conceptual.replications..O. > 0] idNotIntRepl_r <- RPPdata$ID[!is.na(RPPdata$T_r..O.) & !is.na(RPPdata$T_r..R.) & RPPdata$Successful.conceptual.replications..O. == 0] #for studies with significant p reported in original publication idIntRepl_sigp <- RPPdata$ID[!is.na(RPPdata$T_pval_USE..O.) & !is.na(RPPdata$T_pval_USE..R.) & RPPdata$T_sign_O == 1 & RPPdata$Successful.conceptual.replications..O. > 0] idNotIntRepl_sigp <- RPPdata$ID[!is.na(RPPdata$T_pval_USE..O.) & !is.na(RPPdata$T_pval_USE..R.) & RPPdata$T_sign_O == 1 & RPPdata$Successful.conceptual.replications..O. == 0] #Custom functions------------------------------------------------------------------ noninversion <- function(d1, d2) {return(list(d1 + abs(min(c(d1, d2))) + 1, d2 + abs(min(c(d1, d2))) + 1))} inversion <- function(d1, d2) {return(list(-d1 + abs(min(c(-d1, -d2))) + 1, -d2 + abs(min(c(-d1, -d2))) + 1))} normality_evaluation <- function(d1, d2){ #standard Shapiro-Wilks test print(shapiro.test(d1)) print(shapiro.test(d2)) #histogram first distribution hist(d1, 10, freq = F) #histogram second distribution hist(d2,10, freq = F) qqnorm(d1) qqline(d1) qqnorm(d2) qqline(d2) } #Distributions to be addressed----------------------------------------------------- #Effect Size Reduction (simple subtraction) #x1 = c(RPPdata$T_r..R.[idIntRepl_r]) - c(RPPdata$T_r..O.[idIntRepl_r])#ES reduction of internally replicated effects #y1 = c(RPPdata$T_r..R.[idNotIntRepl_r]) - c(RPPdata$T_r..O.[idNotIntRepl_r])#ES reduction of NOT internally replicated effects #Effect Size Reduction (Cohen's q) Cohenq <- function(r1, r2) { fis_r1 = 0.5 * (log((1+r1)/(1-r1))) fis_r2 = 0.5 * (log((1+r2)/(1-r2))) fis_r1 - fis_r2 } #x1 = Cohenq(c(RPPdata$T_r..R.[idIntRepl_r]), c(RPPdata$T_r..O.[idIntRepl_r])) #y1 = Cohenq(c(RPPdata$T_r..R.[idNotIntRepl_r]), c(RPPdata$T_r..O.[idNotIntRepl_r])) #Original study p-value #x1 = RPPdata$T_pval_USE..O.[idIntRepl_sigp] #y1 = RPPdata$T_pval_USE..O.[idNotIntRepl_sigp] #Original study effect size #x1 = RPPdata$T_r..O.[idIntRepl_r] #y1 = RPPdata$T_r..O.[idNotIntRepl_r] #Statistical Power of independent replication #x1 = as.numeric(as.character(RPPdata$Power..R.[idIntRepl_sigp])) #y1 = as.numeric(as.character(RPPdata$Power..R.[idNotIntRepl_sigp])); y1 = y1[!is.na(y1)] #Surprisingness of original effect #x1 = as.numeric(as.character(RPPdata$Surprising.result..O.[idIntRepl_sigp])); x1 = x1[!is.na(x1)] #y1 = as.numeric(as.character(RPPdata$Surprising.result..O.[idNotIntRepl_sigp])); y1 = y1[!is.na(y1)] #Challenge of conducting replication (combination of 3 variables) stand <- function(x) {res <- (x-mean(x, na.rm = TRUE))/sd(x, na.rm = TRUE); return(res)}# Function for standardizing variables fac.expe <- factor(RPPdata$Methodology.expertise.required..O., levels = c("No expertise required", "Slight expertise required", "Moderate expertise required", "Strong expertise required", "Extreme expertise required"))# Create the right order of the variable st.expe <- stand(as.numeric(fac.expe))#standardize variable fac.oppo.expe <- factor(RPPdata$Opportunity.for.expectancy.bias..O., levels = c("No opportunity for researcher expectations to influence results", "Slight opportunity for researcher expectations to influence results", "Moderate opportunity for researcher expectations to influence results", "Strong opportunity for researcher expectations to influence results", "Extreme opportunity for researcher expectations to influence results")) st.oppo.expe <- stand(as.numeric(fac.oppo.expe)) fac.oppo.dili <- factor(RPPdata$Opportunity.for.lack.of.diligence..O., levels = c("No opportunity for lack of diligence to affect the results", "Slight opportunity for lack of diligence to affect the results", "Moderate opportunity for lack of diligence to affect the results", "Strong opportunity for lack of diligence to affect the results", "Extreme opportunity for lack of diligence to affect the results")) st.oppo.dili <- stand(as.numeric(fac.oppo.dili)) sc.chal <- (st.expe + st.oppo.expe + st.oppo.dili)/3# Create scale #x1 = sc.chal[idIntRepl_sigp] #y1 = sc.chal[idNotIntRepl_sigp] #Sample Size x1 = RPPdata$T_N_O_for_tables[idIntRepl_r] y1 = RPPdata$T_N_O_for_tables[idNotIntRepl_r]; y1 = y1[y1 < 100000] #Check distribution without transformation----------------------------------------- x = x1; y = y1 normality_evaluation(x, y) #Addressing negative skew---------------------------------------------------------- #the squared case x = (noninversion(x1, y1)[[1]])^2; y = (noninversion(x1, y1)[[2]])^2 normality_evaluation(x, y) #the cubed case x = (noninversion(x1, y1)[[1]])^3; y = (noninversion(x1, y1)[[2]])^3 normality_evaluation(x[x