spuriouscorrelationRPP

spuriouscorrelation.R

if(!require(ggplot2)){install.packages('ggplot2')}
library(ggplot2)
if(!require(MBESS)){install.packages('MBESS')}
library(MBESS)
#Set color palette
cbbPalette<-c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")


N<-20
#Set mean and SD
d<-0.4
n <- 50000 #set sample size
cor.true <- 0.5 #set true correlation
n1 <- 4000 #set sample size set 1
t = rt(n, N-1, d*sqrt(N)) #generate t-distribution, of size N-1
x1 = t / sqrt(N) #effect sizes (Cohen's d)
x1 <- x1[x1>0.00]
x1 <- sample(x1,n1)
#This formula creates a second sample with identical mean and sd, which is correlated with the first sample.
t = rt(n1, N-1, d*sqrt(N)) #generate t-distribution, of size N-1
z = t / sqrt(N) #effect sizes (Cohen's d)
y1 <- (cor.true * (x1-(mean(x1))) + sqrt(1 - cor.true^2) * z) + d*(1-sqrt(1 - cor.true^2))

N<-20
n <- 50000 #set sample size
cor.true <- 0.0 #set true correlation
d<-0.0
n2 <- 6000 #set sample size set 1
cor.true <- 0.0 #set true correlation
t = rt(n, N-1, d*sqrt(N)) #generate t-distribution, of size N-1
x2 = t / sqrt(N) #effect sizes (Cohen's d)
x2 <- x2[x2>0.00]
x2 <- sample(x2,n2)
#This formula creates a second sample with identical mean and sd, which is correlated with the first sample.
t = rt(n2, N-1, d*sqrt(N)) #generate t-distribution, of size N-1
z = t / sqrt(N) #effect sizes (Cohen's d)
y2 <- (cor.true * (x2-(mean(x2))) + sqrt(1 - cor.true^2) * z) + d*(1-sqrt(1 - cor.true^2))

cond<-c(rep(1,n1),rep(2,n2))
x<-c(x1,x2)
y<-c(y1,y2)


dataset<-as.data.frame(cbind(x,y,cond))



#Plot graph
ggplot(dataset, aes(x=x, y=y, color=cond)) +
  geom_point(size=2) +    # Use hollow circles
  geom_smooth(method=lm, colour="#E69F00", size = 1, fill = "#56B4E9") + # Add linear regression line
  geom_abline(intercept = (100-(cor.true*100)), slope=cor.true, colour="black", linetype="dotted", size=1) +
  xlab("Original") + ylab("Replication")  + ggtitle(paste("Correlation = ",round(cor(x,y),digits=2),sep="")) + theme_bw(base_size=20) + 
  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank()) + theme(legend.position="none")