###########################################################
## JPS analysis in block designs
##########################################################



####################################################
# This function computes  U_i^2, i=1,2.
# It is used in computation of unbiased variance estimate of 
# Tilde_Delta_1(t,t')
######################################################
Ui_F=function(dii_vec){
  nd=length(dii_vec)
  index=expand.grid(1:nd,1:nd)
  index=index[index[,2]-index[,1]!=0,]
  U2_k=mean((dii_vec[index[,1]]-dii_vec[index[,2]])^2) # sum_{i,j}(dii-djj)^2
  return(U2_k)
}

####################################################
# This function computes  U_3^2
# It is used in computation of unbiased variance estimate of 
# Tilde_Delta_1(t,t')
Uij_F=function(dii_vec,djj_vec){
  nd1=length(dii_vec)
  nd2=length(djj_vec)
  index=expand.grid(1:nd1,1:nd2)
  #index=index[index[,2]-index[,1]!=0,]
  U2_3=mean((dii_vec[index[,1]]-djj_vec[index[,2]])^2) # sum_{i,j}(dii-djj)^2
  return(U2_3)
}




#######################################################################
#  Computation of Delta_1(t1,t2)
#  This function computes Delta_1(t1,t2)
# Design: designs matrix whose columns  contains the indices of block and treatments,
#          and ranking covariates
# B: the number of blocks
# C_n: Finite sample coefficient C_n^2 in Lemma 1 
#######################################################################
Contrast_estF=function(Design,B,t1t2,C_n){
  t1=t1t2[1]
  t2=t1t2[2]
  T1_T2_mat=rep(NA,2)
  E1_E2_mat=rep(NA,2)
  Block_level=unique(Design$Blocks)
  Response=Design$Response
  Covariate=Design$Covariate
  for (b in Block_level){
    # Designb=Design[Design[,2]==b,]  # observations from block b
    #  Yt1=Designb[Designb[,3]==t1,4] # treatment t1 observations from block b
    #  R.errt1=Designb[Designb[,3]==t1,5] #Treatment t1 ranking variable
    #  Yt2=Designb[Designb[,3]==t2,4]# treatment t2 observations from block b
    #  R.errt2=Designb[Designb[,3]==t2,5] #Treatment t2 ranking variable
    
    Designb=Design[Design[,1]==b,]  # observations from block b
    Responseb=Designb$Response      # Response measurements from block b
    Covariateb=Designb$Covariate    # Covariate measurements from block b 
    Yt1=Responseb[Designb[,2]==t1]  # treatment t1 observations from block b
    R.errt1=Covariateb[Designb[,2]==t1] #Treatment t1 ranking variableobservations
    Yt2=Responseb[Designb[,2]==t2]# treatment t2 observations from block b
    R.errt2=Covariateb[Designb[,2]==t2] #Treatment t2 ranking variable observations from block b
    
    #Per.t1=sample(1:length(Yt1),length(Yt1))
    #Per.t2=sample(1:length(Yt2),length(Yt2))
    T1_T2_obs=cbind(Yt1,Yt2) # permute
    # t1 and t2 observations
    E1_E2_obs=cbind(R.errt1,R.errt2)
    T1_T2_mat=rbind(T1_T2_mat,T1_T2_obs) # combine all treatment t1 and t2
    # observations from B blocks
    E1_E2_mat=rbind(E1_E2_mat,E1_E2_obs)
  }  
  T1_T2_mat=T1_T2_mat[-1,]
  E1_E2_mat=E1_E2_mat[-1,]
  I.ii=(E1_E2_mat[,1]<E1_E2_mat[,2])
  T1=data.frame(matrix(T1_T2_mat[I.ii,],ncol=2,byrow=F))
  T2=data.frame(matrix(T1_T2_mat[!I.ii,],ncol=2,byrow=F))
  #print(T1)
  #print(T2)
  n1=dim(T1)[1]  # the number of set type 1
  n2=dim(T2)[1]  # the number of set type 2
  n=n1+n2
  if(n1*n2==0) Dn=1 else Dn=2  # the number of non-empty set types
  if(n1 !=0) {dii_1=apply(T1,1,function(u){u[1]-u[2]});Del1=mean(dii_1)} else Del1=0
  if(n2 !=0) {djj_2=apply(T2,1,function(u){u[1]-u[2]});Del2=mean(djj_2)} else Del2=0
  Del_hat=(Del1+Del2)/Dn  # Estimates of Delta_t1t2
  
  #####################################################################
  # Variance estimates 
  if( n1 >1) U2_1=Ui_F(dii_1) else U2_1=0  # Compute U_1^2
  if(n2>1)  U2_2=Ui_F(djj_2) else U2_2=0  # Compute U_2^2 
  if(n1*n2 !=0) U2_3=Uij_F(dii_1,djj_2) else U2_3=0 # Compute U_3^2
  
  S1=0
  if ( n1 >1 & n2>1) {S1=((U2_3-(U2_1+U2_2)/2)/(4*(2^(n-1)))); 
  S2=(U2_1+U2_2)*(C_n/2)}
  if( n1==1) {S1=((U2_3-U2_2)/(4*(2^(n-1))));
  S2=(U2_2)*C_n}
  if( n2==1) {S1=((U2_3-U2_1)/(4*(2^(n-1))));
  S2=(U2_1)*C_n}
  
  if( n1==0) S2=U2_2*C_n
  if(n2==0) S2=U2_1*C_n
  
  S1=S1/(1-2^(-(n-1)))
  
  var.est=S1+S2
  ##############################################################
  #   Var.est: unbiased variance estimate of Tilde_Delta_1(t,t')
  # Del_hat: tilde_Delta_(1,t,t'))
  return(c(var.est,Del_hat))
}
###########################################################################
#########################################################################
















#############################################################
# This function computes tilde(Delta_(1,t,t')) and its unbiased variance estimate
# sample_data: data frame that contains the block, treatment indices and covariates
#              Column1: block,
#               Column2: Treatment,
#               Column3: number of replications  in treatment- block cells,
#               Column4:  Response measurements 
#               Column5:  Covariate
# Pair_treat

Delta1_function=function(sample_data,pair_treat,Num.pairs,B){
  ##################################################
  # Store Tilde_Delta1 estimates and unbiased  variance estimates
  # for each pair t ,t'
  tilde_Delta1_store=matrix(0, ncol=4, nrow=Num.pairs)
  colnames(tilde_Delta1_store)=c("t","t'","Var(Delta_1)","est(Detla_1")
  nB= length(sample_data$Treatment)/length(unique(sample_data$Treatment)) # number replications
  # for each pair t t-prime
  
  #########################################
  n1seq=1:(nB-1)
  n_n1_comb=sum(choose(nB,n1seq)/(2^2*n1seq))
  C_nB=2^(-nB)*(1/(nB)+n_n1_comb)
  # C_nB: C_nb^2 in Lemma 1 in the paper
  ##########################################
  for (k in (1:Num.pairs)){
    t.t_prime=pair_treat[,k] # extract   indeces of treatmwent pairs t, t'
    tilde_Delta1=Contrast_estF(sample_data,B,t.t_prime,C_nB) # computes 
 #                   tilde_Delta1 and its unbiased variance
    tilde_Delta1_store[k,]=c(t.t_prime,tilde_Delta1) 
  }
  return(tilde_Delta1_store)
}



######################################################
# Functions below for the computation of tilde_Delta_3
# and its asymptotic variance estimate
#  sample_data: Data frame
#              Column1: block,
#               Column2: Treatment,
#               Column3: number of replications  in treatment- block cells,
#               Column4:  Response measurements 
#               Column5:  Covariate
# pair_treat: matrix of all pairs of t,t', t <t'
#              the first column: indices of t
#             the second column: indices of t'
#BootN: Bootstrap replication
#####################################################
Delta3_F=function(sample_data,pair_treat,Num.pairs,BootN){
  Block_levels=unique(sample_data$Blocks) # Block levels
  B=length(Block_levels) # number of blocks
  # B=max(sample_data[,1]) # number of blocks
  #nu=max(sample_data[,2]) # number of treatment
  nu=length(unique(sample_data$Treatment)) # number of blocks
  n=dim(sample_data)[1]/(B*nu) # number of replication
  tilde_DElta3_Asymp_Var_store=matrix(0, ncol=4, nrow=Num.pairs)
  tilde_DElta3_Bootstrap_Var_store=matrix(0, ncol=4, nrow=Num.pairs)
  Num.pairs=dim(pair_treat)[2]
  # for (k in (1:Num.pairs)){
  # for (t.t_prime in pair_treat){
  for( tt.ind in (1:Num.pairs)){
    #  t.t_prime= pair_treat[,k] # treatment pair t, t'
    t.t_prime=pair_treat[,tt.ind]
    t_tprime_est=ttprime_F(sample_data,t.t_prime,Block_levels,n) # Asymptoic RAOB variance Estimate
    # RAOB estimate of Delta_2
    tilde_DElta3_Asymp_Var_store[tt.ind,] = c(t.t_prime,t_tprime_est) # point estimate of Delta_(t,t') and
    # its asymptotic variance estimate
    t_t_prime_boot=RAOB_Boot_estF(sample_data,t.t_prime,Block_levels,BootN,n) # bootstrap variance estimate
    tilde_DElta3_Bootstrap_Var_store[tt.ind,]=c(t.t_prime,t_t_prime_boot) # bootstrap variance estimate
  }
  return(list(tilde_DElta3_Asymp_Var_store,tilde_DElta3_Bootstrap_Var_store))
}

#####################################################
### This function is used in Delta3_F 
###  It computes the tilde(Delta_(3,t,t')
### and its asymptotic variance esatimates
#####################################################
ttprime_F=function(sample_data,t.t_prime,Block_levels,n){
  SMAT1=matrix(NA,nrow=4)
  rownames(SMAT1)=c("h11","h12","h13","h14")
  SMAT2=matrix(NA,nrow=4)
  rownames(SMAT2)=c("h21","h22","h23","h24")
  M_ij_Matrix=matrix(NA,ncol=4)
  colnames(M_ij_Matrix)=c("m11","m12","m21","m22")
  PAIR=matrix(NA,ncol=2)
  colnames(PAIR)=c("Y_t","Y_tp")
  B=length(Block_levels)
  DP=numeric()
  RANK3=numeric()
  for (bk in Block_levels){
    model_matrix=sample_data[sample_data$Block==bk,]
    model_matrix=data.frame(model_matrix$Response,model_matrix$Treatment,model_matrix$Covariate)
    colnames(model_matrix)=c("Response", "Treat_index","Error1")
    Blocki=Ustat_blocki(model_matrix, t.t_prime,B)
    SMAT1=cbind(SMAT1,Blocki[[1]])
    SMAT2=cbind(SMAT2,Blocki[[2]])
    M_ij_Matrix=rbind(M_ij_Matrix,Blocki[[3]])
    DP=c(DP,Blocki[[4]])
    RANK3=c(RANK3,Blocki[[5]])
    #print(SMAT2)
    PAIR=rbind(PAIR,Blocki[[6]])
  }
  PAIR=PAIR[-1,]
  SMAT1=SMAT1[,-1]
  
  SMAT2=SMAT2[,-1]
  M_ij_Matrix=M_ij_Matrix[-1,]
  
  mij=apply(M_ij_Matrix,2,function(u){mean(u[u!=0])}) # these are used 
  # in computation of theta^*
  
  
  
  
  ###########################################################
  #  if  The number of Type 1 sets is either zero or n^2, Make one set
  #  Type 2 in order to get a variance estimate
  ####################################################
  if(sum(RANK3)==0){RL=sample(1:length(RANK3),1);RANK3[RL]=1}
  if(sum(RANK3)==length(RANK3)){RL=sample(1:length(RANK3),1);RANK3[RL]=0}
  ##########################################################
  
  ###########################################################
  # New computation of mijs
  New.mij=mij
  New.mij[1]<-mean(PAIR[,1][RANK3==1])
  New.mij[2]<-mean(PAIR[,1][RANK3==0]) 
  New.mij[3]<-mean(PAIR[,2][RANK3==0])
  New.mij[4]<-mean(PAIR[,2][RANK3==1])
  mij=New.mij
  # print("old mij")
  #  print(mij)
  #  print("new mij")
  # print(New.mij)
  # in computation of theta^*
  
  ############################################################
  
  
  if (sum(RANK3)!=0 & sum(RANK3)!=(B*n*n)) { arbe<-((sum(DP[RANK3==1])/sum(RANK3))  #estimate of RABE
                                                    +(sum(DP[RANK3==0])/(B*n*n-sum(RANK3))))/2}else {arbe<-(sum(DP)/(B*n*n));print(arbe)}

  s1=(var(t(SMAT1)))  # Estimate of SIGMA_1 in Theorem 2
  
  
  s2=var(t(SMAT2))  #Estimate of SIGMA_2 in Theorem 2
  T<-2*(s1+s2) #change 1/2 to m_1/n 2.
  # print(T)
  a<-c(0.5*(B*n^2/sum(RANK3)),0.5*(B*n^2/(B*n^2-sum(RANK3))),
       -0.5*(B*n^2/sum(RANK3))*(mij[1]-mij[4]),
       -0.5*(B*n^2/(B*n^2-sum(RANK3)))*(mij[2]-mij[3]))
  ###  a: the estiamte of  G'(theta*) in theorem 2
  var.limit.mat<-t(a)%*%T%*%a
  return(c(B^2*var.limit.mat/(2*n*B),arbe))
}


###########################################################################
#  This function is used ttprime_F
#  It computes the parameters of four-dimensional generalized U-statistics
#  
Ustat_blocki=function(model_matrix, tr_id,B){
  # print(model_matrix)
  # Column 1: Y response
  # Column 2: Treatment indecis
  # Column 3: Error term for auxiliary variable
  #           Their ranks are used to create type 1 and 2 sets 
  Treat_index=model_matrix[,2] 
  n=length(model_matrix[Treat_index==tr_id[1],1])
  ydiff.mat<-matrix(0,n,n)
  xcomp.mat<-matrix(0,n,n)
  p.mat=matrix(0,nrow=n^2,ncol=2)
  p.u=matrix(0,nrow=n^2,ncol=2)
  # Cn.2=Cn.F(n)
  rank3=rep(0,n*n)
  y.mat=matrix(0,n,2)
  u.mat=matrix(0,n,2)
  totrank3=rep(0,n*n)
  Jointrank=matrix(0,n*n,n*n) 
  
  
  y.mat[,1]=model_matrix[Treat_index==tr_id[1],1]
  y.mat[,2]=model_matrix[Treat_index==tr_id[2],1]  
  u.mat[,1]=model_matrix[Treat_index==tr_id[1],3]
  u.mat[,2]=model_matrix[Treat_index==tr_id[2],3] 
  
  
  EXP_G=expand.grid(y.mat[,2],y.mat[,1])
  p.mat=cbind(EXP_G[,2],EXP_G[,1])   # Y_tij,Y_t'ik (reponse pairs from t, t')
  EXP_G=expand.grid(u.mat[,2],u.mat[,1])  
  p.u=cbind(EXP_G[,2],EXP_G[,1])  # x_tij,x_t'ik  (covariate pairs from t, t')
  dp<-(p.mat[,1]-p.mat[,2]) # vector of d_ijk=Y_tij-Y_t'ik 
  
  
  
  rank3<-1*(p.u[,1]<=p.u[,2])  # I_ijk vector
  
  
  pair<-p.mat
  rank.pair<-rank3
  pair123<-y.mat
  rank.pair123<-u.mat
  
  for (a in 1:n) {
    for (b in 1:n){
      ydiff.mat[a,b]<-(pair123[a,1]-pair123[b,2])
      xcomp.mat[a,b]<-(rank.pair123[a,1]<=rank.pair123[b,2])}}
  
  m11<-mean(pair[,1][rank.pair==1])
  m12<-mean(pair[,1][rank.pair==0]) 
  m21<-mean(pair[,2][rank.pair==0])
  m22<-mean(pair[,2][rank.pair==1])
  
  ## return m_ij_matrix to compute theta^* in Theorem 2
  m_ij_matrix=cbind(pair[,1]*(rank.pair==1),pair[,1]*(rank.pair==0),
                    pair[,2]*(rank.pair==0), pair[,2]*(rank.pair==1))
  
  
  
  
  u11<-ydiff.mat*xcomp.mat
  u12<-ydiff.mat*(matrix(1,n,n)-xcomp.mat)
  u13<-xcomp.mat
  u14<-matrix(1,n,n)-xcomp.mat
  
  h13<-apply(u13,1,mean)
  h14<-apply(u14,1,mean)
  h11<-apply(u11,1,mean)
  h12<-apply(u12,1,mean)
  
  smat1<-rbind(h11,h12,h13,h14)/B # Four-dimensional random sample to estimate SIGMA_1   in Theorem 2
  
  u21<-ydiff.mat*xcomp.mat
  u22<-ydiff.mat*(matrix(1,n,n)-xcomp.mat)
  u23<-xcomp.mat
  u24<-matrix(1,n,n)-xcomp.mat
  
  h23<-apply(u23,2,mean)
  h24<-apply(u24,2,mean)
  h21<-apply(u21,2,mean)
  h22<-apply(u22,2,mean)
  
  smat2<-rbind(h21,h22,h23,h24)/B #  Four-dimensional random sample to estimate SIGMA_2   in Theorem 2 # 
  
  return(list(smat1=smat1,smat2=smat2,m_ij_matrix=m_ij_matrix,dp=dp,rank3=rank3,PAIR=pair))
}

#############################################################################
##########  End of Delta_3 Asymptotic
#########################################################################

###########################################################
# This function computes the bootstrap variance estimate of Tilde_Delta_(3,t,t')  
#####################################################
RAOB_Boot_estF=function(sample_data,t.t_prime,Block_levels,BootN,n){
  DP=numeric()
  RANK3=numeric() 
  B=length(Block_levels)
  within_block_resp=vector(mode="list", B)
  bkid=1
  for (bk in Block_levels){
    model_matrix=sample_data[sample_data$Block==bk,]
    model_matrix=data.frame(model_matrix$Response,model_matrix$Treatment,model_matrix$Covariate)
    colnames(model_matrix)=c("Response", "Treat_index","Error1")
    within_block_resp[[bkid]]=Combblocki(model_matrix, t.t_prime)
    bkid=bkid+1
  }
  boot_stor=rep(0,BootN)
  for( bbb in (1:BootN)){
    boot_stor[bbb]=BootF(within_block_resp,n)
  }
  boot.mean=mean(boot_stor) # bootstrap mean estimate
  boot.var=var(boot_stor) # Bootstrap variance estimate
  return(c( boot.var,boot.mean))
}

########################################################
#  This function is used RAOB_Boot_estF
# It creates Matrices M_i in Algorithm 1, (M_1,M_2, ..., M_b)
###################################################
Combblocki=function(model_matrix, tr_id){
  # print(model_matrix)
  # Column 1: Y response
  # Column 2: Treatment indecis
  # Column 3: Error term for auxiliary variable
  #           Their ranks are used to create type 1 and 2 sets        
  Treat_index=model_matrix[,2]
  n=length(model_matrix[Treat_index==tr_id[1],1])
  y.mat=matrix(0,n,2)
  colnames(y.mat)=c("Y_t","Y_t'")
  u.mat=matrix(0,n,2)
  colnames(u.mat)=c("x_t","x_t'")
  
  
  y.mat[,1]=model_matrix[Treat_index==tr_id[1],1]
  y.mat[,2]=model_matrix[Treat_index==tr_id[2],1]  
  u.mat[,1]=model_matrix[Treat_index==tr_id[1],3]
  u.mat[,2]=model_matrix[Treat_index==tr_id[2],3] 
  
  return(cbind(y.mat, u.mat))
}

########################################################
#  This function generates bootstrap samples for Tilde(DElta_(3,t,t'))
######################################################################
BootF=function(within_block_resp,n){
  B=length(within_block_resp)
  RANK3=numeric()
  Y.dif=numeric()
  for(bb in (1:B)){
    block.bb=within_block_resp[[bb]]
    boot_rep=sample(1:n,replace=TRUE)
    Block_bb_rep=block.bb[boot_rep,]
    y.mat=Block_bb_rep[,c(1,2)]
    u.mat=Block_bb_rep[,c(3,4)]
    EXP_G=expand.grid(y.mat[,2],y.mat[,1])
    p.mat=cbind(EXP_G[,2],EXP_G[,1])   # Y_tij,Y_t'ik (reponse pairs from t, t')
    EXP_G=expand.grid(u.mat[,2],u.mat[,1])  
    p.u=cbind(EXP_G[,2],EXP_G[,1])  # x_tij,x_t'ik  (covariate pairs from t, t')
    dp<-(p.mat[,1]-p.mat[,2]) # vector of d_ijk=Y_tij-Y_t'ik 
    rank3<-1*(p.u[,1]<=p.u[,2])  # I_ijk vector
    RANK3=c(RANK3,rank3)
    Y.dif=c(Y.dif,dp)
  }
  N=length(Y.dif)
  #print(N)
  if(sum(RANK3)==0){RL=sample(1:N,1);RANK3[RL]=1}
  if(sum(RANK3)==N){RL=sample(1:N,1);RANK3[RL]=0}
  ##########################################################
  ############################################################
  
  
  if (sum(RANK3)!=0 & sum(RANK3)!=(N)) { arbe<-((sum(Y.dif[RANK3==1])/sum(RANK3))  #estimate of RABE
                    +(sum(Y.dif[RANK3==0])/(N-sum(RANK3))))/2}else {arbe<-(sum(DP)/(N));print(arbe)}
  return(arbe)
}
############################################################################################################
#############  End of Tilde_Delta3 Estimates #########################################################
#########################################################################################################





####################################################################################################
####  Start of Tilde_Delta2 Estimates 
#  The function below computes Tilde_Delta_(2,t,t') 
#  sample_data: Data frame
#              Column1: block,
#               Column2: Treatment,
#               Column3: number of replications  in treatment- block cells,
#               Column4:  Response measurements 
#               Column5:  Covariate
# pair_treat: matrix of all pairs of t,t', t <t'
#              the first column: indices of t
#             the second column: indices of t'
#BootN: Bootstrap replication
# PermuteN: This is the intgewr L in Alorithm 2 
#############################################################################


Delta2_F=function(sample_data,pair_treat,BootN, PermuteN){
  B=length(sample_data[,1]) # number of blocks
  Num.pairs=dim(pair_treat)[2] # number of treatment pairs 
  tilde_DElta2_Boot_store=matrix(0, ncol=4, nrow=Num.pairs)
  #  tilde_DElta3_Bootstrap_Var_store=matrix(0, ncol=4, nrow=Num.pairs)
  
  for (k in (1:Num.pairs)){
    t.t_prime= pair_treat[,k] # treatment pair t, t'
    # t_tprime_est=ttprime_F(sample_data,t.t_prime,B) # Asymptoic RAOB variance Estimate
    # RAOB estimate of Delta_2
    # tilde_DElta2_Boot_store[k,] = c(t.t_prime,t_tprime_est) # point estimate of Delta_(t,t') and
    # its asymptotic variance estimate
    t_t_prime_boot=Delta2_Vest(sample_data,t.t_prime,B,BootN,PermuteN) # Delta 1 estimate and
    # its  bootstrap variance estiamtes
    # RAOB_Boot_estF(sample_data,t.t_prime,B,Bootrep) # bootstrap variance estimate
    tilde_DElta2_Boot_store[k,]=c(t.t_prime,t_t_prime_boot) # bootstrap variance estimate
  }
  return(tilde_DElta2_Boot_store)
}

Delta2_Vest=function(sample_data,t.t_prime,B,BootN,PermuteN){
  DP=numeric()
  RANK3=numeric() 
  Block_levels=sort(unique(sample_data$Blocks))
  B=length(Block_levels)
  within_block_resp=vector(mode="list", B)
  for (bk in (1:B)){
    model_matrix=sample_data[sample_data$Block==Block_levels[bk],]
    model_matrix=data.frame(model_matrix$Response,model_matrix$Treatment,model_matrix$Covariate)
    colnames(model_matrix)=c("Response", "Treat_index","Error1")
    # print(model_matrix)
    within_block_resp[[bk]]=Combblocki(model_matrix, t.t_prime)
  }
  Delta2_est=Delta2_est_function(within_block_resp,PermuteN) #Estimates Rao-blackwallized Delta_1
  Delta2_Boot_var_est=Delta2_boot_var_est_func(within_block_resp,BootN,PermuteN)
  return(c(Delta2_Boot_var_est,Delta2_est))  
  
}

Delta2_est_function=function(within_block_resp,PermuteN){
  B=length(within_block_resp)
  delt1=numeric()
  for( it in (1:PermuteN)){
    Y.dif=numeric()
    RANK3=numeric()
    for(bb in (1:B)){
      Tem=  within_block_resp[[bb]]
      nTem=dim(Tem)[1]
      permut=sample(1:nTem, nTem)
      Tem_permute=Tem[permut, c(1,3)]
      Y.dif_bb=Tem_permute[,1]-Tem[,2]
      Rank3.bb=1*(Tem_permute[,2] < Tem[,4])
      Y.dif=c(Y.dif,Y.dif_bb)
      RANK3=c(RANK3,Rank3.bb)
    }
    N=length(Y.dif)
    #print(N)
    if(sum(RANK3)==0){RL=sample(1:N,1);RANK3[RL]=1}
    if(sum(RANK3)==N){RL=sample(1:N,1);RANK3[RL]=0}
    ##########################################################
    ############################################################
    
    
    if (sum(RANK3)!=0 & sum(RANK3)!=(N)) { arbe<-((sum(Y.dif[RANK3==1])/sum(RANK3))  #estimate of RAO_Blackwellazed E
                                                  +(sum(Y.dif[RANK3==0])/(N-sum(RANK3))))/2}else {arbe<-(sum(Y.dif)/(N));print(arbe)}
    delt1=c(delt1,arbe)
  }
  delt1=mean(delt1)
  return(delt1)
}


Delta2_boot_var_est_func=function(within_block_resp,BootN,PermuteN){
  B=length(within_block_resp)
  Delta1_boot_rep=numeric()  
  for (BRep in (1:BootN)){
    Boot_within_block_resp=within_block_resp
    for( bb in (1:B)){
      tem=Boot_within_block_resp[[bb]]
      nr=dim(tem)[1]
      bootind=sample(1:nr, nr, replace=TRUE)
      tem=tem[bootind,]
      Boot_within_block_resp[[bb]]=tem
    }
    Delta1_boot_rep[BRep]=Delta2_est_function(Boot_within_block_resp, PermuteN)
  } 
  Boot_delta1_var=var(Delta1_boot_rep)
  return(Boot_delta1_var)
}



# for pretty output
setClass('jps_pair_block', representation('list'))
setMethod("show", "jps_pair_block", function(object) {
  cat(paste0(object$title, "\n"))
  print(object$summary, row.names=FALSE)
  cat(paste0(object$warning, "\n"))
})



###########################################################################################################################
#  This is the R-function that combines all of the previous functions to compute the 
# Tilde_1, Tilde_2 and Tilde_3 estimators
# Documentation about how to use the function if given below
##################################################################333

JPS_Pair_block=function(sample_data,Jps_method=1,pairwise_method="Tukey",conf_level=0.95,var_est=1, BootN=200,PermuteN=200){
  ###########################################################################################
  #  sample_data: Data frame
  #
  #     Column 1: Block indicator
  #     Column 2: Treatment indicator
  #     Column 3: Replication indicator 
  #     Column 4: Response measurements
  #     Column 5: Covariate
  #               Their ranks are used to create type 1 and 2 sets
  #   jps_method: Type of estimator 
  #               jps_method=1, tilde_1
  #               jps_method=2, tilde_2
  #               jps_method=3, tilde_3
  #   pairwise_method: can be either "Tukey", "Bonferroni"
  #   conf_level: Family-wise confidence level
  #   var_est: Indicator for variance estimates for jps_method=3
  #               var_est=1  asymptotic variance estimate
  #               var_est=2  Bootstrap variance estimate
  #               var_est=3  Average of  asymptotic and bootstrap variance estimates.
  #   BootN:  Bootsrap replication size in tilde_2 and tilde_3
  #   PermuteN:  Permutation size in tilde_2
  #   
  ####################################################################################
  
  treatment_levels=sort(unique(sample_data$Treatment))   # treatment levels
  nu=length(treatment_levels)  # number of treatment
  nB=length(sample_data$Treatment)/nu # number replications
  # for each pair t t-prime
  Block_levels=sort(unique(sample_data$Block)) # Block levels
  B=length(Block_levels)  # the number of blocks
  pair_treat=combn(treatment_levels,2) # List of pairwise contrasts parameters
  Num.pairs=dim(pair_treat)[2] # Number of pairwise contrast 
  alpha=1-conf_level
  
  ###################################################################
  # point and variance estimate of tilde_Delta_1 estimator
  #####################################################################
  if(Jps_method==1) {Tilde_Delta_r=Delta1_function(sample_data,pair_treat,Num.pairs,B) 
  SE_Delta_r=sqrt(mean(Tilde_Delta_r[,3])) #compute SE of tilde_delta_1
  Tilde_delta_est_r=Tilde_Delta_r[,c(1,2,4)] # point estimates of pair-wise
  # contrasts parameters
  SE_Warning=paste("Standard error (SE) is computed from unbiased variance estimate of tilde_delta_1")  
  title=paste(conf_level*100, "Percent simultaneous", pairwise_method, "confidence intervals using tilde_Delta_1" )
  }
  ###############################################################################
  
  
  ##############################################################################
  #  Point and its  asymptotic variance estimate of tilde_Delta_3
  ############################################################################
  if(Jps_method==3 ){Tilde_Delta_3=Delta3_F(sample_data,pair_treat,Num.pairs,BootN)
  Asymp_var_est=Tilde_Delta_3[[1]]
  Boot_var_est=Tilde_Delta_3[[2]]
  SE_Delta3_asy=sqrt(mean(Asymp_var_est[,3])) #compute SE of tilde_delta_3 asymptotic
  SE_Delta3_Boot=sqrt(mean(Boot_var_est[,3])) #compute SE of tilde_delta_3 Bootstrap
  Average_Boot_asymp=(Asymp_var_est[,3]+Boot_var_est[,3])/2
  SE_Delta3_Boot_Asym=sqrt(mean(Average_Boot_asymp))
  Tilde_delta_est_r=Asymp_var_est[,c(1,2,4)] # point estimates of pair-wise
  # contrasts parameters
  if(var_est==1){SE_Warning=paste("Standard error (SE) is computed from asymptotic variance estimate of tilde_delta_3");
  SE_Delta_r=SE_Delta3_asy}
  if(var_est==2){SE_Warning=paste("Standard error (SE) is computed from bootstrap variance estimate of tilde_delta_3");
  SE_Delta_r=SE_Delta3_Boot}
  if(var_est==3){SE_Warning=paste("Standard error (SE) is computed from the average of asymptotic and bootstrap  variance estimate of tilde_delta_3");
  SE_Delta_r=SE_Delta3_Boot_Asym}
  title=paste(conf_level*100, "Percent simultaneous", pairwise_method, "confidence intervals using tilde_Delta_3" )
  }
  ###############################################################################
  
  #################################################################################
  ### Point estimate and its bootstrap variance estimate of tilde_Delta_2  
  ################################################################################
  if(Jps_method==2 ){Tilde_Delta_2=Delta2_F(sample_data,pair_treat,BootN,PermuteN)
  SE_Delta_r=sqrt(mean(Tilde_Delta_2[,3])) #compute SE of tilde_delta_2 Bootstrap
  Tilde_delta_est_r=Tilde_Delta_2[,c(1,2,4)]
  title=paste(conf_level*100, "Percent simultaneous", pairwise_method, "confidence intervals using tilde_Delta_2" )
  SE_Warning=paste("Standard error (SE) is computed from the average of asymptotic and bootstrap  variance estimate of tilde_delta_2")
  }
  
  ################################################################################
  # Inference for Bonferroni procedure 
  ################################################################################
  if (pairwise_method=="Bonferroni"){t_quantile=qt(1-alpha/(2*Num.pairs),nB-1)
  LL=Tilde_delta_est_r[,3]-t_quantile*SE_Delta_r
  UL=Tilde_delta_est_r[,3]+t_quantile*SE_Delta_r
  T_stat=(Tilde_delta_est_r[,3]-0)/SE_Delta_r
  P_value=2*(1-pt(abs(T_stat),nB-1))
  P_value=Num.pairs*P_value
  P_value[P_value>1]=1
  summary=data.frame(Tilde_delta_est_r,rep(SE_Delta_r,Num.pairs),rep(nB-1,Num.pairs), LL,UL,T_stat,P_value) 
  summary=round(summary,digits=4)
  colnames(summary)=c("t","t_prime","Estimate", "SE", "df","LL","UL","t.ratio","p.value")
  summary=within(summary, {t<-treatment_levels[t]; t_prime<-treatment_levels[t_prime]})
  #UMMARY<-print.data.frame(summary, row.names=FALSE)
  }
  ###################################################################################
  
  
  ################################################################################
  # Inference for Tukey procedure 
  ################################################################################
  if (pairwise_method=="Tukey"){Q_quantile=qtukey(conf_level,nu,(nB-1))/sqrt(2)
  LL=Tilde_delta_est_r[,3]-Q_quantile*SE_Delta_r
  UL=Tilde_delta_est_r[,3]+Q_quantile*SE_Delta_r
  T_stat=(Tilde_delta_est_r[,3]-0)/(SE_Delta_r/sqrt(2))
  P_value=(1-ptukey(abs(T_stat),nu,nB-1))
  summary=data.frame(Tilde_delta_est_r,rep(SE_Delta_r,Num.pairs), rep(nB-1,Num.pairs),LL,UL,T_stat,P_value) 
  summary=round(summary,digits=4)
  #colnames(summary)=c("t","t'","Estimate", "SE","df", "LL","UL","t.ratio","p.value")
  colnames(summary)=c("t","t_prime","Estimate", "SE", "df","LL","UL","t.ratio","p.value")
  summary=within(summary, {t<-treatment_levels[t]; t_prime<-treatment_levels[t_prime]})
  #row.names(summary)<-NULL
  }
  ###################################################################################
  
  
  
  ##################################################
  # Return analysis results
  # message(title)  # print the title
  # print(summary, row.names=FALSE)  # print the analysis results
  # message(SE_Warning) # prints warning about how SE is computed
  return(new('jps_pair_block', list(title=title, summary=summary, warning=SE_Warning)))
}


# for pretty output
#setClass('jps_pair_block', representation('list'))
#setMethod("show", "jps_pair_block", function(object) {
#  cat(paste0(object$title, "\n"))
#  print(object$summary, row.names=FALSE)
#  cat(paste0(object$warning, "\n"))
#})






#########################################################################################
########################################################################################### 
# Codes blow apply the  R-function to perform the analysis of 
# Soil fumigant experiment.
##############################################################################33333

########################
# we instal the packages we used in the analysis 

if (!require("ggplot2"))
{
  install.packages("ggplot2")
  library(ggplot2)
}

if (!require("dplyr"))
{
  install.packages("dplyr")
  library(dplyr)
}

if (!require("tidyverse"))
{
  install.packages("tidyverse")
  library(tidyverse)
}

if (!require("ggpubr"))
{
  install.packages("ggpubr")
  library(ggpubr)
}


if (!require("emmeans"))
{
  install.packages("emmenas")
  library(emmeans)
}

if (!require("xtable"))
{
  install.packages("xtable")
  library(xtable)
}


#source("JPS_Block.R")


########################################################
#  Read the data for soil fumigant experiment
library(agridat)
data(cochran.eelworms) 
dat <- cochran.eelworms



#########################################
# Create data set with  two control groups
# We try to create two control groups 
# to avoid any clustering among response variablee
control1<-c(1,7,22,24,26,32,40,44)
control2<- c(6,11,14,17,29,35,45,46)
#########################################

#

##############################################
# Split the control into two control groups 
treat=as.character(dat$fumigant)
treat[control1]="Con1"
treat[control2]="Con2"
treat=factor(treat)
dat_contr2=dat
dat_contr2[,4]=factor(treat)
######### Check if we have balanced dewsign
table(dat_contr2$block,dat_contr2$fumigant)
####################################################################


#############################################################
## Create a new data frame with relevant variables
# Block
# Treatment (fumigant)
# Response (Final eelworm count)
# Covariate (Initial eelworm counts)
Sample_Data=data.frame(dat_contr2$block,dat_contr2$fumigant,dat_contr2$col,dat_contr2$final,dat_contr2$initial)
colnames(Sample_Data)=c("Blocks","Treatment","Replication","Response","Covariate")

##################################################################################3
# Analysis without transformation
###############################################################################
PP=  JPS_Pair_block(Sample_Data,pairwise_method="Tukey",Jps_method=3,var_est=3) 
#  PP is JPS pairwise inference
Treat.f=factor(Sample_Data$Treatment)
Block.f=factor(Sample_Data$Blocks)
Acova=aov(Sample_Data$Response~Block.f+Treat.f+Sample_Data$Covariate) # Fit covariance model
ANova=aov(Sample_Data$Response~Block.f+Treat.f) # fit anova modeld
ResAnova=ANova$residuals # get the residuals from anova model 
AA=cbind(ResAnova,Sample_Data$Covariate)
cor(AA)  # correlation coefficient between the resuduals and covariate
print(anova(Acova))
print(xtable(data.frame(anova(Acova))))
LSM=emmeans(Acova,~Treat.f)
Tukeyint=contrast(LSM,method="pairwise",  inf=c(T,T),level=0.95) #Tukey procedure
                    #  Using acova
print(Tukeyint)
########### Correlation coefficient between the response (final count) and covariate (initial count)
cor(Sample_Data$Covariate,Sample_Data$Response)
##########################################
#############################################################################################################
###  End of analysis without transformation
#############################################################################################################








#######################################################
# Squared root transformation
set.seed(7)
sample_data_sqrt=Sample_Data
sample_data_sqrt[,4]=sqrt(sample_data_sqrt[,4])
sample_data_sqrt[,5]=sqrt(sample_data_sqrt[,5])
#PP=JPS_block(sample_data=sample_data_sqrt,pairwise_method="Tukey",Jps_method=3,var_est=2)
#PP=JPS_Pair_block(sample_data=sample_data_sqrt,pairwise_method="Tukey",Jps_method=3,var_est=2)
PP=JPS_Pair_block(sample_data_sqrt,pairwise_method="Tukey",Jps_method=3,var_est=2, BootN=1000,PermuteN=200)
#Eeelworms_tilde3.table=print(xtable(data.frame(PP),digits=c(1,1,1,3,3,0,3,3,3,3)),include.rownames=FALSE)


Acova=aov(sample_data_sqrt$Response~Block.f+Treat.f+sample_data_sqrt$Covariate)
#print(anova(Acova))
print(xtable(data.frame(anova(Acova))))
LSM=emmeans(Acova,~Treat.f)
Tukeyint.acova=contrast(LSM,method="pairwise",  inf=c(T,T),level=0.95)
print(Tukeyint.acova)
Tukey.table=print(xtable(data.frame(Tukeyint),digits=c(1,1,3,3,0,3,3,3,3)),include.rownames=FALSE)

Anovasqrt=aov(sample_data_sqrt$Response~Block.f+Treat.f)
Ressqrt=Anovasqrt$residuals
Correlation=cor(cbind(Ressqrt,sqrt(sample_data_sqrt$Covariate)))
print(Correlation)
LSM_anova=emmeans(Anovasqrt,~Treat.f)
Tukeyint.anova=contrast(LSM_anova,method="pairwise",  inf=c(T,T),level=0.95)


###########################################################################
# Create Table of Tukey multiple com,pariosn of example
LS_no_Cov=data.frame(data.frame(Tukeyint.anova)[,c(1,2,3,8)])
LS_Cov=data.frame(data.frame(Tukeyint.acova)[,c(2,3,8)])
JPS=PP[[2]][,c(3,4,9)]
Tukey_Multiple_Comp_table=cbind(LS_no_Cov,LS_Cov,JPS)
print(xtable(Tukey_Multiple_Comp_table,digits=c(1,1,3,3,3,3,3,3,3,3,3)),include.rownames=FALSE)
##########################################




#####################################################################################
# Creates the Eealworms plots of example for square-root transformation 
###############################################################################

sample_data_sqrt=data.frame(sample_data_sqrt,Ressqrt,ResLog,ResAnova)
sample_data_sqrt=within(sample_data_sqrt,Treatment<-factor(Treatment))
library(ggplot2)
# scatter plot between response and covariate without transfortmation 
Plot1= ggplot(data = sample_data_sqrt, 
                   aes(x=Covariate^2,y=Response^2, group = Treatment, color=Treatment))+
  geom_point(mapping=aes(shape=Treatment))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Initial count of eelworms", y="Final count of eelworms", color="Treatment")+
  theme(
    axis.title.x = element_text(size = 20),axis.title.y = element_text(size = 15),
    axis.text.x=element_text(size = 20), axis.text.y=element_text(size = 15), 
    legend.text=element_text(size=20),legend.title=element_text(size=20))
#,title="Scatter plot for intitial and final fumigant counts for blocks 1 and 2")

###  Scatter plot between covariate and fitted residuyals without transformation
Plot2= ggplot(data = sample_data_sqrt,
  #data = sample_data_red_Block1, 
                 aes(x=Covariate^2,y=ResAnova, group = Treatment, color=Treatment))+
  geom_point(mapping=aes(shape=Treatment))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Initial count of eelworms", y="Residuals", color="Treatment")+
  theme(
    axis.title.x = element_text(size = 20),axis.title.y = element_text(size = 15),
    axis.text.x=element_text(size = 20), axis.text.y=element_text(size = 15), 
    legend.text=element_text(size=20),legend.title=element_text(size=20))
#, title="Scatter plot for intitial and final fumigant counts for block 1")


# Scatter plot between covariate and residuals with square root transformation
Plot3= ggplot(data = sample_data_sqrt, 
                 aes(x=Covariate,y=Ressqrt, group = Treatment, color=as.factor(Treatment)))+
  geom_point(mapping=aes(shape=Treatment))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Square root of initial count of eelworms", y="Residuals", color="Treatment")+
  theme(
    axis.title.x = element_text(size = 20),axis.title.y = element_text(size = 15),
    axis.text.x=element_text(size = 20), axis.text.y=element_text(size = 15), 
    legend.text=element_text(size=20),legend.title=element_text(size=20))
#,title="Scatter plot for intitial and final fumigant counts for block 2")

### Scatter plot bewtween response and covariate with square-root transformation
Plot4= ggplot(data = sample_data_sqrt, 
              aes(x=(Covariate),y=(Response), group = Treatment, color=Treatment))+
  geom_point(mapping=aes(shape=Treatment))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Square root of initial count of eelworms", y="Square root of final count of eelworms", color="Treatment")+
  theme(
    axis.title.x = element_text(size = 20),axis.title.y = element_text(size = 15),
    axis.text.x=element_text(size = 20), axis.text.y=element_text(size = 15), 
    legend.text=element_text(size=20),legend.title=element_text(size=20))
#,title="Scatter plot for intitial and final fumigant counts for block 2")




figure1<- ggarrange(Plot1,Plot2,Plot4, Plot3,
                      labels=c("Without transformation", 
                               "Without transformation",
                               "With transformation","With transformation"),
                    label.y=0.95,
                      heights=c(1,1,0.5,1,1),
                      ncol=2, nrow=2)
ggsave("linearityplot.pdf",plot=figure1,width=13,height=12)

###################################################################################################
##############  End of plots  eealwoprm data with square rrot transformation  #####################
##############################################################################################





































###############################################################################
######### log transformation  ###############################################
################################################################################
sample_data_log=Sample_Data
sample_data_log[,4]=log(sample_data_log[,4])
sample_data_log[,5]=log(sample_data_log[,5])
PP=JPS_block(sample_data=sample_data_log,pairwise_method="Tukey",Jps_method=3,var_est=2)
Acova=aov(sample_data_log$Response~Block.f+Treat.f+sample_data_log$Covariate)
LSM=emmeans(Acova,~Treat.f)
Tukeyint=contrast(LSM,method="pairwise",  inf=c(T,T),level=0.95)
print(Tukeyint)
Anovalog=aov(log(sample_data_log$Response)~Block.f+Treat.f)
ResLog=Anovalog$residuals # residuals from anova model when rersponse is log-transformed
cor(cbind(ResLog,log(sample_data_log$Covariate))) # Correlation between residuals and covariate 

##########################
# Log transformation 
logPlot= ggplot(data = Sample_Data, 
              aes(x=log(Covariate),y=log(Response), group = as.factor(Treatment), color=as.factor(Treatment)))+
  geom_point(mapping=aes(shape=as.factor(Treatment)))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Initial count of eelworms", y="Final count of eelworms", color="Treatment")




logPlot2= ggplot(data = sample_data_red_Block1, 
              aes(x=log(Covariate),y=log(Response), group = as.factor(Treatment), color=as.factor(Treatment)))+
  geom_point(mapping=aes(shape=as.factor(Treatment)))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Initial count of eelworms", y="Final count of eelworms", color="Treatment")
#, title="Scatter plot for intitial and final fumigant counts for block 1")

logPlot3= ggplot(data = sample_data_red_Block2, 
              aes(x=log(Covariate),y=log(Response), group = as.factor(Treatment), color=as.factor(Treatment)))+
  geom_point(mapping=aes(shape=as.factor(Treatment)))+
  geom_smooth(method= "lm", se = F)+
  labs(x="Initial count of eelworms", y="Final count of eelworms", color="Treatment")
#,title="Scatter plot for intitial and final fumigant counts for block 2")

logfigure<- ggarrange(logPlot,logPlot2,logPlot3, 
                   labels=c("Blocks 1 and 2", "Block 1", "Block 2"),
                   ncol=2, nrow=2)
ggsave("linearityplot_log.pdf",plot=logfigure,width=13)