# Import functions
source(".../functions.R") # Change "..." to the location of "functions.R"
library(survival)

# Define the shape ans scale parameters for the survival functions of the failure times and the censoring time in the three groups
alpha1<-2.5
beta1<-0.4
alpha2<-2.5
beta2<-0.5
alpha3<-2.5
beta3<-0.6
alpha_C<-10
beta_C<-0.6

# Plot the survival functions of the failure times and the censoring time
t<-seq(0,1,length=1000)
plot(t,1-pweibull(t, shape = alpha1, scale = beta1),ylim=c(0,1),xlab="t",ylab="", type="l",lwd=3.0,col=2) 
par(new=TRUE)
plot(t,1-pweibull(t, shape = alpha2, scale = beta2),ylim=c(0,1),xlab="t",ylab="", type="l",lwd=3.0,col=4) 
par(new=TRUE)
plot(t,1-pweibull(t, shape = alpha3, scale = beta3),ylim=c(0,1),xlab="t",ylab="", type="l",lwd=3.0,col="darkgreen") 
par(new=TRUE)
plot(t,1-pweibull(t, shape = alpha_C, scale = beta_C),xlim=c(0,1),ylim=c(0,1),xlab="t",ylab="", type="l",lwd=3.0,lty=2,col="gray50") 
legend("topright",
       legend=c(expression(S[1](t),S[2](t),S[3](t),paste(S[1]^'*',(t),", ",S[2]^'*',(t),", ",S[3]^'*',(t)))),
       col=c(2,4,"darkgreen","gray50"),
       cex=1,
       lty=c(1,1,1,2),
       lwd=3.0,
       xjust=1, yjust=1)

# Compute ES_MW between group 1 and group 2 and between group 1 and group 3
myint_MW<-function(s,alpha1,beta1,alpha2,beta2){
  ( exp(-(s/beta1)^alpha1)*(alpha2/beta2)*(s/beta2)^(alpha2-1)*exp(-(s/beta2)^alpha2) )
}
ES_MW_12<-1-2*(integrate(myint_MW, 0,2,alpha1=alpha1,beta1=beta1,alpha2=alpha2,beta2=beta2)$value)
ES_MW_13<-1-2*(integrate(myint_MW, 0,2,alpha1=alpha1,beta1=beta1,alpha2=alpha3,beta2=beta3)$value)

# Compute ES_L between group 1 and group 2
p1<-0.5
p2<-1-p1
myint_L<-function(s,p1,p2,alpha1,beta1,alpha2,beta2,alpha_C1,beta_C1,alpha_C2,beta_C2){
  ( exp(-(s/beta1)^alpha1)*exp(-(s/beta_C1)^alpha_C1)*exp(-(s/beta2)^alpha2)*exp(-(s/beta_C2)^alpha_C2)*((alpha1*(s/beta1)^(alpha1-1)/beta1-alpha2*(s/beta2)^(alpha2-1)/beta2)))/(p1*exp(-(s/beta1)^alpha1)*exp(-(s/beta_C1)^alpha_C1)+p2*exp(-(s/beta2)^alpha2)*exp(-(s/beta_C2)^alpha_C2))
}

ES_L_12<-integrate(myint_L,0,1,p1=0.5,p2=0.5,alpha1=alpha1,beta1=beta1,alpha2=alpha2,beta2=beta2,alpha_C1=alpha_C,beta_C1=beta_C,alpha_C2=alpha_C,beta_C2=beta_C)$value

# Compute ES_G between group 1 and group 2 and between group 1 and group 3

myint_G<-function(s,alpha1,beta1,alpha2,beta2,alpha_C1,beta_C1,alpha_C2,beta_C2){
  ( exp(-(s/beta1)^alpha1)*exp(-(s/beta_C1)^alpha_C1)*exp(-(s/beta2)^alpha2)*exp(-(s/beta_C2)^alpha_C2)*((alpha1*(s/beta1)^(alpha1-1)/beta1-alpha2*(s/beta2)^(alpha2-1)/beta2)))
}

ES_G_12<-integrate(myint_G,0,Inf,alpha1=alpha1,beta1=beta1,alpha2=alpha2,beta2=beta2,alpha_C1=alpha_C,beta_C1=beta_C,alpha_C2=alpha_C,beta_C2=beta_C)$value
ES_G_13<-integrate(myint_G,0,Inf,alpha1=alpha1,beta1=beta1,alpha2=alpha3,beta2=beta3,alpha_C1=alpha_C,beta_C1=beta_C,alpha_C2=alpha_C,beta_C2=beta_C)$value

# Compute ES_P between group 1 and group 2 and between group 1 and group 3

myint_P<-function(s,alpha1,beta1,alpha2,beta2,alpha_C1,beta_C1,alpha_C2,beta_C2){
  exp(-(s/beta1)^alpha1)*exp(-(s/beta2)^alpha2)*exp(-(s/beta_C1)^alpha_C1) *((alpha1*(s/beta1)^(alpha1-1)/beta1-alpha2*(s/beta2)^(alpha2-1)/beta2)) 
}

ES_P_12<-integrate(myint_P,0,Inf,alpha1=alpha1,beta1=beta1,alpha2=alpha2,beta2=beta2,alpha_C1=alpha_C,beta_C1=beta_C,alpha_C2=alpha_C,beta_C2=beta_C)$value 
ES_P_13<-integrate(myint_P,0,Inf,alpha1=alpha1,beta1=beta1,alpha2=alpha3,beta2=beta3,alpha_C1=alpha_C,beta_C1=beta_C,alpha_C2=alpha_C,beta_C2=beta_C)$value

# Compute censoring rates in each group

CR1<-integrate(myint_MW, 0,2,alpha1=alpha1,beta1=beta1,alpha2=alpha_C,beta2=beta_C)$value
CR2<-integrate(myint_MW, 0,2,alpha1=alpha2,beta1=beta2,alpha2=alpha_C,beta2=beta_C)$value
CR3<-integrate(myint_MW, 0,2,alpha1=alpha3,beta1=beta3,alpha2=alpha_C,beta2=beta_C)$value

# Summarize the effect sizes between group 1 and group 2 
noquote(formatC(signif(cbind(ES_L_12,ES_G_12,ES_P_12,ES_MW_12,CR1,CR2),digits=2),digits=2, flag="#"))

# Summarize the effect sizes between group 1 and group 3
noquote(formatC(signif(cbind(NULL,ES_G_13,ES_P_13,ES_MW_13,CR1,CR3),digits=2),digits=2, flag="#"))

# Compute the estimates of the effect sizes for the simulated datasets
set.seed(123)

tau_star<-0.6

results_12<-NULL
results_13<-NULL

CRhat1s<-NULL
CRhat2s<-NULL
CRhat3s<-NULL

for(n1_plus_n2 in c(2000,4000,6000,8000,10000,15000,20000,25000,30000,40000)){  

  results_xy<-NULL
  results_xz<-NULL
  results_yz<-NULL
  
  group1.ori=NULL
  group2.ori=NULL
  group3.ori=NULL
  
  v1f <- runif(n1_plus_n2/2,0,1)
  temp1f = beta1*(-log(v1f))^(1/alpha1)
  v1c <- runif(n1_plus_n2/2,0,1)
  temp1c = beta_C*(-log(v1c))^(1/alpha_C) 
  
  v2f <- runif(n1_plus_n2/2,0,1)
  temp2f = beta2*(-log(v2f))^(1/alpha2)
  v2c <- runif(n1_plus_n2/2,0,1)
  temp2c = beta_C*(-log(v2c))^(1/alpha_C) 
  
  v3f <- runif(2000,0,1)
  temp3f = beta3*(-log(v3f))^(1/alpha3)
  v3c <- runif(2000,0,1)
  temp3c = beta_C*(-log(v3c))^(1/alpha_C) 
  
  data_group1=cbind(pmin(temp1f, temp1c) , as.numeric(temp1f <= temp1c))
  data_group2=cbind(pmin(temp2f, temp2c) , as.numeric(temp2f <= temp2c))
  data_group3=cbind(pmin(temp3f, temp3c) , as.numeric(temp3f <= temp3c))
  
  tempdata_12<-rbind.data.frame(cbind(data_group1,1),cbind(data_group2,2))
  names(tempdata_12)<-c("time","delta","group")
  tempdata_12$group<-as.factor(tempdata_12$group)

  tempdata_13<-rbind.data.frame(cbind(data_group1,1),cbind(data_group3,2))
  names(tempdata_13)<-c("time","delta","group")
  tempdata_13$group<-as.factor(tempdata_13$group)
  
  CRhat1<-sum(group1.ori[,1]>group1.ori[,2])/nrow(group1.ori)
  CRhat2<-sum(group2.ori[,1]>group2.ori[,2])/nrow(group2.ori)
  CRhat3<-sum(group3.ori[,1]>group3.ori[,2])/nrow(group3.ori)
  
  result_12<-c(nrow(tempdata_12),WL(tempdata_12),ES_WL(tempdata_12),ES_MWE(tempdata_12,tau1=tau_star,tau2=tau_star),ES_MWC(tempdata_12,tau=tau_star))
  results_12<-rbind(results_12,result_12)

  result_13<-c(nrow(tempdata_13),WL(tempdata_13),ES_WL(tempdata_13),ES_MWE(tempdata_13,tau1=tau_star,tau2=tau_star),ES_MWC(tempdata_13,tau=tau_star))
  results_13<-rbind(results_13,result_13)
  
  CRhat1s<-c(CRhat1s,CRhat1)
  CRhat2s<-c(CRhat2s,CRhat2)
  CRhat3s<-c(CRhat3s,CRhat3)
  
  plot(survfit(Surv(time,delta)~group, data=tempdata_12[tempdata_12$group==1,]),ylim=c(0,1),xlim=c(0,1),conf.int=F,main=bquote(paste(n[1]+n[2], " = " ,.(n1_plus_n2))),lwd=3.0,col=2) 
  par(new=TRUE)
  plot(survfit(Surv(time,delta)~group, data=tempdata_12[tempdata_12$group==2,]),ylim=c(0,1),xlim=c(0,1),conf.int=F,lwd=3.0,col=4) 
  par(new=TRUE)
  plot(survfit(Surv(time,delta)~group, data=tempdata_13[tempdata_13$group==2,]),ylim=c(0,1),xlim=c(0,1),conf.int=F,lwd=3.0,col="darkgreen") 
  legend("topright",
         legend=c(expression(widehat(S)[1](t),widehat(S)[2](t),widehat(S)[3](t))),
         col=c(2,4,"darkgreen"),
         cex=1,
         lty=c(1,1,1),
         lwd=3.0,
         xjust=1, yjust=1)

  print(n1_plus_n2)
}

colnames(results_12)<-c("n1+n2","Logrank test statistic","P-value of the logrank test statistic","Gehan-Wilcoxon test statistsic","P-value of the Gehan-Wilcoxon test statistic","Prentice-Wilcoxon text statistic","P-value of the Prentice-Wilcoxon test statistic","EShat_L","EShat_G","EShat_P","EShat_MWE","EShat_MWC")
rownames(results_12)<-c()

colnames(results_13)<-c("n1+n3","Logrank test statistic","P-value of the logrank test statistic","Gehan-Wilcoxon test statistsic","P-value of the Gehan-Wilcoxon test statistic","Prentice-Wilcoxon text statistic","P-value of the Prentice-Wilcoxon test statistic","EShat_L","EShat_G","EShat_P","EShat_MWE","EShat_MWC")
rownames(results_13)<-c()

# Summarize the test statistsics, p-values, and estimates of effect sizes between group 1 and group 2
noquote(formatC(signif(results_12,digits=2),digits=2, flag="#"))

# Summarize the test statistsics, p-values, and estimates of effect sizes between group 1 and group 3
noquote(formatC(signif(results_13,digits=2),digits=2, flag="#"))