library(numDeriv)
alpha0=2.0
beta0=1
rep=10000

sink(file = "alpha2_LU_10.txt")
suppressWarnings({

for (jj in 1:12){

if (jj==1) r=c(0,rep(0,3),10)
if (jj==2) r=c(10,rep(0,3),0)
if (jj==3) r=c(5,rep(0,3),5)
if (jj==4) r=c(10,rep(0,8),0)
if (jj==5) r=c(0,rep(0,8),10)
if (jj==6) r=c(5,rep(0,8),5)
if (jj==7) r=c(0,rep(0,13),20)
if (jj==8) r=c(20,rep(0,13),0)
if (jj==9) r=c(10,rep(0,13),10)
if (jj==10) r=c(0,rep(0,18),20)
if (jj==11) r=c(20,rep(0,18),0)
if (jj==12) r=c(10,rep(0,18),10)

m=length(r)
n=sum(r+1)

lowlr1=0;lowwald1=0;lowbn1=0;lowlg1=0
upplr1=0;uppwald1=0;uppbn1=0;upplg1=0

lowlr=0;lowwald=0;lowbn=0;lowlg=0
upplr=0;uppwald=0;uppbn=0;upplg=0

lowlr10=0;lowwald10=0;lowbn10=0;lowlg10=0
upplr10=0;uppwald10=0;uppbn10=0;upplg10=0

data=c(rep(0,m))

ii=0
while (ii <= rep)
{
W<-matrix((runif(m,0,1)),m,1)
E<-matrix(NA,m,1);V<-matrix(NA,m,1);U<-matrix(NA,m,1)
i<-1
while (i<=m) {   
E[i]<- 1/( i+ sum(r[(m+1-i):m])) 
i<-i+1
}
V<-W^E
i<-1
while (i<=m) {
		   
U[i]<- (1- prod( V[(m+1-i):m])) 
i<-i+1
}
 
data=(-1/beta0)*log(1-U^(1/alpha0))

log.lik <- function(par){
  alpha <- par[1] 
  beta <- par[2]
  return(-(m*log(alpha)+m*log(beta)-beta*sum(data)+(alpha-1)*sum(log(1-exp(-beta*data)))+sum(r*log(1-(1-exp(-beta*data))^alpha))))
}

result=nlm(log.lik, c(alpha0,beta0),hessian = TRUE)
ah=result$estimate[1]
bh=result$estimate[2]

hess=result$hessian
lik=-1*result$minimum

log.lik0 <- function(par){
beta <- par[1]
  return(-(m*log(alpha0)+m*log(beta)-beta*sum(data)+(alpha0-1)*sum(log(1-exp(-beta*data)))+sum(r*log(1-(1-exp(-beta*data))^alpha0))))

}

result0=nlm(log.lik0, c(bh),hessian = TRUE)
bh0=result0$estimate[1]
hess0=result0$hessian
lik0=-1*result0$minimum

pph=(1-exp(-bh*data))
pp0=(1-exp(-bh0*data))
bbh=(1-exp(-bh*data))^ah
bb0=(1-exp(-bh0*data))^alpha0

FS11=m/alpha0^2+sum(r*bb0*(log(pp0))^2/(1-bb0)^2)
yy1=alpha0*data^2*bb0*((bb0-1)*exp(bh0*data)+alpha0)
yy2=(1-bb0)^2*(1-exp(bh0*data))^2
cc=sum(r*yy1/yy2)
FS22=m/bh0^2+(alpha0-1)*sum(data^2*exp(-bh0*data)/(1-exp(-bh0*data))^2)+cc
xx1=data*bb0*(alpha0*log(pp0)-bb0+1)
dd=sum(r*xx1/((1-bb0)^2*(exp(bh0*data)-1)))
FS12=-sum(data*exp(-bh0*data)/(1-exp(-bh0*data)))+dd
FS21=FS12
FSR1=c(FS11,FS12)
FSR2=c(FS21,FS22)
hesstilde=rbind(FSR1,FSR2)

##### THE MATRIX PHI - TILDE
QQ=-(1-exp(-bh*data))*log(1-exp(-bh*data))/(ah*bh*exp(-bh*data))
br0=bh0*exp(-bh0*data)/(1-exp(-bh0*data))
phi11tilde=sum(QQ*(br0-r*bh0*bb0*(alpha0*log(pp0)-bb0+1)/((1-bb0)^2*(exp(bh0*data)-1))))
AA=(exp(-bh0*data)-data*bh0*exp(-bh0*data))*(1-exp(-bh0*data))-data*bh0*exp(-2*bh0*data)
BB=(1-exp(-bh0*data))^2
CC=alpha0*bb0*(((bh0*data-1)*bb0-bh0*data+1)*exp(bh0*data)+bb0+alpha0*bh0*data-1)
phi12tilde=sum(QQ*(-1+(alpha0-1)*AA/BB-r*CC/((1-bb0)^2*(exp(bh0*data)-1)^2)))
phi21tilde=-sum((bh0*exp(-bh0*data)/(1-exp(-bh0*data))-r*bh0*bb0*(alpha0*log(pp0)-bb0+1)/((1-bb0)^2*(exp(bh0*data)-1)))*data/bh)
phi22tilde=-sum((data/bh)*(-1+(alpha0-1)*AA/BB-r*alpha0*bb0*(((bh0*data-1)*bb0-bh0*data+1)*exp(bh0*data)+bb0+alpha0*bh0*data-1)/((1-bb0)^2*(exp(bh0*data)-1)^2)))
phrow1=c(phi11tilde, phi12tilde)
phrow2=c(phi21tilde, phi22tilde)
mphi=rbind(phrow1,phrow2)

##### THE MATRIX PHI - HAT
br=bh*exp(-bh*data)/(1-exp(-bh*data))
phi11=sum(QQ*(br-r*bh*bbh*(ah*log(pph)-bbh+1)/((1-bbh)^2*(exp(bh*data)-1))))
AA=(exp(-bh*data)-data*bh*exp(-bh*data))*(1-exp(-bh*data))-data*bh*exp(-2*bh*data)
BB=(1-exp(-bh*data))^2
CC=ah*bbh*(((bh*data-1)*bbh-bh*data+1)*exp(bh*data)+bbh+ah*bh*data-1)
phi12=sum(QQ*(-1+(ah-1)*AA/BB-r*CC/((1-bbh)^2*(exp(bh*data)-1)^2)))
phi21=-sum((bh*exp(-bh*data)/(1-exp(-bh*data))-r*bh*bbh*(ah*log(pph)-bbh+1)/((1-bbh)^2*(exp(bh*data)-1)))*data/bh)
phi22=-sum((data/bh)*(-1+(ah-1)*AA/BB-r*ah*bbh*(((bh*data-1)*bbh-bh*data+1)*exp(bh*data)+bbh+ah*bh*data-1)/((1-bbh)^2*(exp(bh*data)-1)^2)))
phhrow1=c(phi11, phi12)
phhrow2=c(phi21, phi22)
mphhi=rbind(phhrow1,phhrow2)


####THE VECTOR PSI-BETA
psibeta=c(1,0)

############ THE VECTOR PHI-HAT
phi1=sum(QQ*(-bh+(ah-1)*bh*exp(-bh*data)/(1-exp(-bh*data))-r*ah*bh*(1-exp(-bh*data))^(ah-1)*exp(-bh*data)/(1-bbh)))
phi2=-sum((data/bh)*(-bh+(ah-1)*bh*exp(-bh*data)/(1-exp(-bh*data))-r*ah*bh*(1-exp(-bh*data))^(ah-1)*exp(-bh*data)/(1-bbh)))
phi=c(phi1,phi2)
phi

############ THE VECTOR PHI-TILDE
phi10=sum(QQ*(-bh0+(alpha0-1)*bh0*exp(-bh0*data)/(1-exp(-bh0*data))-r*alpha0*bh0*(1-exp(-bh0*data))^(alpha0-1)*exp(-bh0*data)/(1-bb0)))
phi20=-sum((data/bh)*(-bh0+(alpha0-1)*bh0*exp(-bh0*data)/(1-exp(-bh0*data))-r*alpha0*bh0*(1-exp(-bh0*data))^(alpha0-1)*exp(-bh0*data)/(1-bb0)))
phi0=c(phi10,phi20)
phi0


############ CHI-HAT
chihat=(t(psibeta)%*%solve(mphi))%*%phi

############ CHI - TILDE
chitilde=(t(psibeta)%*%solve(mphi))%*%phi0

############## VAR-HAT-CHI
var=(t(psibeta)%*%solve(hesstilde))%*%psibeta

##############Computation of likelihood statistics

d1=det(hess)*(det(mphhi))^(-2)
d2=det(hesstilde)*(det(mphi))^(-2)
Q=sign(ah-alpha0)*abs(chihat-chitilde)*sqrt(d1/(var*d2))
R=sign(ah-alpha0)*sqrt(2*(lik-lik0))
LGRC=pnorm(R)+dnorm(R)*(1/R-1/Q)
BNDRF=pnorm(R-(1/R)*log(R/Q))
dd1=R^2
xx=solve(hess)
dd2=(ah-alpha0)^2/xx[1,1]
if (is.na(R)==FALSE)
{
ii=ii+1

########## WALD 0.01
if (1-pchisq(dd2,1)<0.01 && ah>alpha0) lowwald1=lowwald1+1
if (1-pchisq(dd2,1)<0.01 && ah<alpha0) uppwald1=uppwald1+1


########### LRT 0.01
if (2*(1-pnorm(abs(R)))<0.01 && ah>alpha0) lowlr1=lowlr1+1
if (2*(1-pnorm(abs(R)))<0.01 && ah<alpha0) upplr1=upplr1+1

########### BNDRF 0.01
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.01 && ah>alpha0) lowbn1=lowbn1+1
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.01 && ah<alpha0) uppbn1=uppbn1+1

########### LGRC 0.01
if (2*min(LGRC, 1-LGRC)<0.01 && ah>alpha0) lowlg1=lowlg1+1
if (2*min(LGRC, 1-LGRC)<0.01 && ah<alpha0) upplg1=upplg1+1


########## WALD 0.05
if (1-pchisq(dd2,1)<0.05 && ah>alpha0) lowwald=lowwald+1
if (1-pchisq(dd2,1)<0.05 && ah<alpha0) uppwald=uppwald+1


########### LRT 0.05
if (2*(1-pnorm(abs(R)))<0.05 && ah>alpha0) lowlr=lowlr+1
if (2*(1-pnorm(abs(R)))<0.05 && ah<alpha0) upplr=upplr+1

########### BNDRF 0.05
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.05 && ah>alpha0) lowbn=lowbn+1
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.05 && ah<alpha0) uppbn=uppbn+1

########### LGRC 0.05
if (2*min(LGRC, 1-LGRC)<0.05 && ah>alpha0) lowlg=lowlg+1
if (2*min(LGRC, 1-LGRC)<0.05 && ah<alpha0) upplg=upplg+1


########## WALD 0.1
if (1-pchisq(dd2,1)<0.1 && ah>alpha0) lowwald10=lowwald10+1
if (1-pchisq(dd2,1)<0.1 && ah<alpha0) uppwald10=uppwald10+1


########### LRT 0.1
if (2*(1-pnorm(abs(R)))<0.1 && ah>alpha0) lowlr10=lowlr10+1
if (2*(1-pnorm(abs(R)))<0.1 && ah<alpha0) upplr10=upplr10+1

########### BNDRF 0.1
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.1 && ah>alpha0) lowbn10=lowbn10+1
if (2*(1-pnorm(abs(R-(1/R)*log(R/Q))))<0.1 && ah<alpha0) uppbn10=uppbn10+1

########### LGRC 0.1
if (2*min(LGRC, 1-LGRC)<0.1 && ah>alpha0) lowlg10=lowlg10+1
if (2*min(LGRC, 1-LGRC)<0.1 && ah<alpha0) upplg10=upplg10+1
}
}

#############Caculation of error rates

l11=lowwald1/rep
l21=lowlr1/rep
l31=lowbn1/rep
l41=lowlg1/rep

u11=uppwald1/rep
u21=upplr1/rep
u31=uppbn1/rep
u41=upplg1/rep

l1=lowwald/rep
l2=lowlr/rep
l3=lowbn/rep
l4=lowlg/rep

u1=uppwald/rep
u2=upplr/rep
u3=uppbn/rep
u4=upplg/rep



l110=lowwald10/rep
l210=lowlr10/rep
l310=lowbn10/rep
l410=lowlg10/rep

u110=uppwald10/rep
u210=upplr10/rep
u310=uppbn10/rep
u410=upplg10/rep

cat(jj,n,m,l1,u1,l1+u1,l2,u2,l2+u2,l3,u3,l3+u3,l4,u4,l4+u4,"\n")
cat(jj,n,m,l11,u11,l11+u11,l21,u21,l21+u21,l31,u31,l31+u31,l41,u41,l41+u41,"\n")
cat(jj,n,m,l110,u110,l110+u110,l210,u210,l210+u210,l310,u310,l310+u310,l410,u410,l410+u410,"\n")
}
})
sink(file = NULL)

