########################################################################################################
# Script for article "Internal conceptual replications do not increase independent replication success"#
# Submitted to Psychonomic Bulletin & Review                                                           #
# Responsible for this file: R. Kunert (rikunert@gmail.com)                                            # 
########################################################################################################

#This script generates a figure published in the supplementary material

#setwd(choose.dir())

# source functions

if(!require(pwr)){install.packages('pwr')} #power analysis
library(pwr)

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'))

##########################################################################################################################################################################################
#-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#The simulation paramers
N_min_general = 10;
N_max_general = 100;
N_sim_general = 15000;

#The plotting parameters
FS = 12#standard plotting font size
PS = 1.5#standard data point size
theme_set(theme_bw(FS)+ #specify plotting theme (essentially Fred Hasselman's clean theme with bigger font size)
            theme(panel.grid.major = element_blank(),
                  panel.grid.minor = element_blank(),
                  panel.border = element_blank(),
                  axis.line  = element_line(colour = "black"),
                  legend.key = element_blank()
            ))

vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y)
cols_in = c("#F0E442", "#D55E00", "#009E73", "#56B4E9", "#0072B2", "#CC79A7")#colours used for plotting inside
cols_out = c("#d5c711", "#a24700", "#006b4e", "#29a0e3", "#00517f", "#be548f")#colours used for plotting outside
shapes = c(21, 21, 24, 24, 24, 25)#shapes used for plotting

##########################################################################################################################################################################################
#-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#General data simulation function

QRP_dat_sim <- function(N_sim = 1000, N_min = 5, N_max = 3000, N_step = 1, ESs_d_true = 0, noise_true = 1,
                        ES_uncertainty = 0, power_analysis = 1, opt_stop = 0){
  
  #make sure that maximum sample size is greater than minimum sample size
  if(N_max < N_min + 1){
    N_max = N_min + 1
  }
  
  #initialise variables
  ES_measured_r = matrix(data=NA,nrow=N_sim,ncol=1)
  N = matrix(data=NA,nrow=N_sim,ncol=1)
  P = matrix(data=NA,nrow=N_sim,ncol=1)
  req_N = matrix(data=NA,nrow=N_sim,ncol=1)
  ES_d_true = matrix(data=NA,nrow=N_sim,ncol=1)
  ES_d_esti = matrix(data=NA,nrow=N_sim,ncol=1)
  
  ###
  #EFFECT SIZE UNCERTAINTY
  
  #add noise to effect size estimation?
  if (length(unique(ESs_d_true))>1){#if there is more than one effect size put in, add uncertainty
    
    #a priori estimated effect sizes
    ESs_d_esti = ESs_d_true
    
    #true effect sizes can be a bit different, add noise
    ESs_d_true = c(ESs_d_true, -1 * ESs_d_true)#add negative effect sizes
    ESs_d_true = (ESs_d_true * (1-ES_uncertainty) +#weight true effect size by uncertainty
                    sample(ESs_d_true) * ES_uncertainty); #weight noise in effect sizes by uncertainty                      
    ESs_d_true = ESs_d_true[1:length(ESs_d_esti)]#extract previously non-negative ES
    
  } else {#if only one effect size put in, forget about uncertainty
    
    ESs_d_true = unique(ESs_d_true)
    ESs_d_esti = unique(ESs_d_true)
  }
  
  for (simulation in 1:N_sim){#for each simulation round
    
    #choose a random effect size
    ES_d_idx = round(runif(1, 1, length(ESs_d_true)))    
    ES_d_esti[simulation] = ESs_d_esti[ES_d_idx]    
    ES_d_true[simulation] = ESs_d_true[ES_d_idx]
    
    ###
    #POWER ANALYSIS
    
    if(power_analysis == 1){#if power analysis is performed
      pwr = pwr.t.test(d = max(c(0.01, ES_d_esti[simulation])), power = .80, type = "one.sample")#determine required sample size for certain power    
      req_N[simulation] = min(ceiling(pwr$n), N_max)
    } else {#if no power analysis, choose sample size randomly (for optional stopping max is always chosen)
      req_N[simulation] = round(runif(1, N_min, N_max))
    }
    
    #initialise RTs variable
    RTs = matrix(data=NA,nrow=N_max,ncol=1)
    
    ###
    #SAMPLING UNTIL SIGNIFICANT
    
    if(opt_stop == 1){#if sampling until significant
      
      #fill with initial sample size
      RTs[1:N_min] = rnorm(N_min, mean = ES_d_true[simulation], sd = noise_true)
      
      for (participant in seq(N_min + 1, N_max, N_step)){#for each potential participant
        
        #test for significance
        stat = t.test(RTs, subset = !is.na(RTs))
        
        if (stat$p.value <= .05){#if significant
          break#leave loop
        } else {#if not significant
          #sample N_step more participant(s)
          RTs[participant : participant + N_step - 1] = rnorm(N_step, mean = ES_d_true[simulation], sd = noise_true)
        }
      }
      
    } else {#if not sampling until significant            
      RTs[1:req_N[simulation]] = rnorm(req_N[simulation], mean = ES_d_true[simulation], sd = noise_true)#fill RTs vector with req_N numbers
    }        
    
    #record outcome of this simulation round    
    ES_measured_r[simulation] = (mean(na.omit(RTs))/sd(na.omit(RTs)))/sqrt((mean(na.omit(RTs))/sd(na.omit(RTs)))^2 + 1)#turn into r
    stat = t.test(RTs, subset = !is.na(RTs))
    N[simulation] = stat$parameter + 1;#df + 1
    P[simulation] = stat$p.value;
  }
    
  ###
  #OUTPUT
  
  return = list(ES_measured_r = ES_measured_r,
                N = N,
                P = P, 
                ES_d_esti = ES_d_esti,
                ES_d_true = ES_d_true,
                req_N = req_N)  
}

##########################################################################################################################################################################################
#-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#Data simulation for single effect size per simulation (Figures S1)

ESs_d = seq(0,1.35,0.01)^2
#ESs_d = seq(0.45,0.51, 0.005)^2#zoom in on region where optional stopping leads to lowest sample sizes
#ESs_d = seq(0.99,1.02, 0.005)^2#zoom in on region where power analysis leads to lowest sample sizes
ESs_r = matrix(data=NA,nrow=length(ESs_d),ncol=1)

#Figure S1 variables
sign_tests_QRP_optStop = matrix(data=NA,nrow=length(ESs_d),ncol=1)
sign_tests_QRP_pubBias = matrix(data=NA,nrow=length(ESs_d),ncol=1)
sign_tests_QRP_HARK = matrix(data=NA,nrow=length(ESs_d),ncol=1)
sign_tests_QRP_all3 = matrix(data=NA,nrow=length(ESs_d),ncol=1)
sign_tests_nonQRP_noPow = matrix(data=NA,nrow=length(ESs_d),ncol=1)
sign_tests_nonQRP_pow = matrix(data=NA,nrow=length(ESs_d),ncol=1)

N_QRP_optStop = matrix(data=NA,nrow=length(ESs_d),ncol=1)
N_QRP_pubBias = matrix(data=NA,nrow=length(ESs_d),ncol=1)
N_QRP_HARK = matrix(data=NA,nrow=length(ESs_d),ncol=1)
N_QRP_all3 = matrix(data=NA,nrow=length(ESs_d),ncol=1)
N_nonQRP_noPow = matrix(data=NA,nrow=length(ESs_d),ncol=1)
N_nonQRP_pow = matrix(data=NA,nrow=length(ESs_d),ncol=1)

ES_r_measured_QRP_optStop = matrix(data=NA,nrow=length(ESs_d),ncol=1)
ES_r_measured_QRP_pubBias = matrix(data=NA,nrow=length(ESs_d),ncol=1)
ES_r_measured_QRP_HARK = matrix(data=NA,nrow=length(ESs_d),ncol=1)
ES_r_measured_QRP_all3 = matrix(data=NA,nrow=length(ESs_d),ncol=1)
ES_r_measured_nonQRP_noPow = matrix(data=NA,nrow=length(ESs_d),ncol=1)
ES_r_measured_nonQRP_pow = matrix(data=NA,nrow=length(ESs_d),ncol=1)

for(i in 1:length(ESs_d)){
  
  ESs_r[i] = ESs_d[i]/sqrt(ESs_d[i]^2+1)#transform mean difference to r-value
  
  #simulate data
  dat_QRP_optStop = QRP_dat_sim(N_sim = N_sim_general, N_min = N_min_general, N_max = N_max_general, N_step = 1,
                                ESs_d_true = ESs_d[i], noise_true = 1,
                                ES_uncertainty = 0, power_analysis = 0,
                                opt_stop = 1)                  
  dat_nonQRP_noPow = QRP_dat_sim(N_sim = N_sim_general, N_min = N_min_general, N_max = N_max_general, N_step = 1,                            
                                 ESs_d_true = ESs_d[i], noise_true = 1,
                                 ES_uncertainty = 0, power_analysis = 0,
                                 opt_stop = 0)    
  dat_nonQRP_pow = QRP_dat_sim(N_sim = N_sim_general, N_min = N_min_general, N_max = N_max_general, N_step = 1,                            
                               ESs_d_true = max(0.001, ESs_d[i]), noise_true = 1,
                               ES_uncertainty = 0, power_analysis = 1,
                               opt_stop = 0)    
  
  #publication bias strategy is simply publishing a subset of the no power analysis strategy, save time by running this  
  dat_QRP_pubBias = list(P = dat_nonQRP_noPow$P[dat_nonQRP_noPow$P <= .05],
                         N = dat_nonQRP_noPow$N[dat_nonQRP_noPow$P <= .05],
                         ES_measured_r = dat_nonQRP_noPow$ES_measured_r[dat_nonQRP_noPow$P <= .05])
  #HARKing is simply interpreting all ES as positive
  dat_QRP_HARK = list(P = dat_nonQRP_noPow$P,
                      N = dat_nonQRP_noPow$N,
                      ES_measured_r = abs(dat_nonQRP_noPow$ES_measured_r))
  
  dat_QRP_all3 = list(P = dat_QRP_optStop$P[dat_QRP_optStop$P <= .05],
                      N = dat_QRP_optStop$N[dat_QRP_optStop$P <= .05],
                      ES_measured_r = abs(dat_QRP_optStop$ES_measured_r[dat_QRP_optStop$P <= .05]))
  
  #collect summary values for Figure S1
  sign_tests_QRP_optStop[i] = sum(dat_QRP_optStop$P <= 0.05)/length(dat_QRP_optStop$P)
  sign_tests_QRP_pubBias[i] = sum(dat_QRP_pubBias$P <= 0.05)/length(dat_QRP_pubBias$P)
  sign_tests_QRP_HARK[i] = sum(dat_QRP_HARK$P <= 0.05)/length(dat_QRP_HARK$P)
  sign_tests_QRP_all3[i] = sum(dat_QRP_all3$P <= 0.05)/length(dat_QRP_all3$P)
  sign_tests_nonQRP_noPow[i] = sum(dat_nonQRP_noPow$P <= 0.05)/length(dat_nonQRP_noPow$P)
  sign_tests_nonQRP_pow[i] = sum(dat_nonQRP_pow$P <= 0.05)/length(dat_nonQRP_pow$P)
  
  N_QRP_optStop[i] = mean(dat_QRP_optStop$N)
  N_QRP_pubBias[i] = mean(dat_QRP_pubBias$N)
  N_QRP_HARK[i] = mean(dat_QRP_HARK$N)
  N_QRP_all3[i] = mean(dat_QRP_all3$N)
  N_nonQRP_noPow[i] = mean(dat_nonQRP_noPow$N)
  N_nonQRP_pow[i] = mean(dat_nonQRP_pow$N)
  
  ES_r_measured_QRP_optStop[i] = mean(dat_QRP_optStop$ES_measured_r)
  ES_r_measured_QRP_pubBias[i] = mean(dat_QRP_pubBias$ES_measured_r)
  ES_r_measured_QRP_HARK[i] = mean(dat_QRP_HARK$ES_measured_r)
  ES_r_measured_QRP_all3[i] = mean(dat_QRP_all3$ES_measured_r)
  ES_r_measured_nonQRP_noPow[i] = mean(dat_nonQRP_noPow$ES_measured_r)
  ES_r_measured_nonQRP_pow[i] = mean(dat_nonQRP_pow$ES_measured_r)
    
  print(sprintf('%1.1f per cent of simulations done', i/length(ESs_d) * 100))
  
}

##########################################################################################################################################################################################
#-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#Figure S1: sample size, positive test rate, effect size estimation

#prepare data frame for visualisation
dat_vis <- data.frame(Strategy = rep(c("QRPs: All Combined","QRP 1: Optional Stopping", "QRP 2: Publication Bias", "QRP 3: HARKing", "No QRP: Random Sampling", "No QRP: 80% Power"), each=length(ESs_d)),
                      ES_r_true = rbind(cbind(ESs_r), cbind(ESs_r), cbind(ESs_r), cbind(ESs_r), cbind(ESs_r), cbind(ESs_r)),
                      P = rbind(cbind(sign_tests_QRP_all3), cbind(sign_tests_QRP_optStop), cbind(sign_tests_QRP_pubBias), cbind(sign_tests_QRP_HARK), cbind(sign_tests_nonQRP_noPow), cbind(sign_tests_nonQRP_pow)),
                      N = rbind(cbind(N_QRP_all3), cbind(N_QRP_optStop), cbind(N_QRP_pubBias), cbind(N_QRP_HARK), cbind(N_nonQRP_noPow), cbind(N_nonQRP_pow)),
                      ES_r_measured = rbind(cbind(ES_r_measured_QRP_all3), cbind(ES_r_measured_QRP_optStop), cbind(ES_r_measured_QRP_pubBias), cbind(ES_r_measured_QRP_HARK), cbind(ES_r_measured_nonQRP_noPow), cbind(ES_r_measured_nonQRP_pow)))
dat_vis$Strategy = relevel(dat_vis$Strategy, "No QRP: Random Sampling")#reorder labels

A = ggplot(data=dat_vis, aes(x=ES_r_true, y=N, group=Strategy))+
  geom_point(aes(color=Strategy, fill = Strategy, shape=Strategy),size=PS) +#scatter plot
  scale_colour_manual(values = cols_out)+#colour for marker outline
  scale_fill_manual(values = cols_in) + #colour for marker area
  scale_shape_manual(values = shapes)+#marker shape
  labs(y="Mean Sample Size N", x="True Effect Size r")+#add axis titles  
  ylim(0, N_max_general) + 
  theme(legend.title=element_blank())#remove legend title

B = ggplot(data=dat_vis, aes(x=ES_r_true, y=P, group=Strategy))+
  geom_point(aes(color=Strategy, fill = Strategy, shape=Strategy),size=PS) +
  scale_colour_manual(values = cols_out)+
  scale_fill_manual(values = cols_in) + 
  scale_shape_manual(values = shapes)+
  labs(y="P(Significant Tests)", x="True Effect Size r")+
  ylim(0, 1)+ 
  theme(legend.position="none")#remove legend

C = ggplot(data=dat_vis, aes(x=ES_r_true, y=ES_r_measured, group=Strategy))+
  geom_point(aes(color=Strategy, fill = Strategy, shape=Strategy),size=PS) +
  scale_colour_manual(values = cols_out)+
  scale_fill_manual(values = cols_in) + 
  scale_shape_manual(values = shapes)+
  geom_abline(intercept=0,slope=1,color="black")+#perfect estimation line
  labs(y="Mean Observed Effect Size r", x="True Effect Size r")+
  ylim(-0.1, 1)+ 
  theme(legend.position="none")#remove legend

#prepare common legend
tmp <- ggplot_gtable(ggplot_build(A)) 
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
legend <- tmp$grobs[[leg]]

#combine plots
grid.arrange(grobs = list(A + theme(legend.position="none"), B, C, legend))

#I used RStudio's export function with aspect ratio 800 x 400 to save the figure as eps file, then used Adobe Illustrator for saving in different formats