
#' @title Expectation step of the Expectation-Maximization (EM) algorithm to calculate the MLE of the Complier Average Causal Effect (CACE) for binary outcomes
#' @description E.step.bin2() implements the Expectation step of the EM algorithm to calculate the MLE of CACE for binary outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' py.c0, py.c1 = probabilities that the outcome takes on value 1 for compliers under control and under treatment;
#' py.nt = probability that the outcome takes on value 1 for never-takers;
#' py.at = probability that the outcome takes on value 1 for always-takers
#' @return  A vector with the expected compliance status for each unit in the data set
#' @export
E.step.bin2 <- function(theta, dat) {
    
    # Conditional probabilities using Bayes' Rule
    
    num0 <- theta$pi.c * stats::dbinom(dat$Y, 1, theta$py.c0)  # C,0
    den0 <- theta$pi.nt * stats::dbinom(dat$Y, 1, theta$py.nt) + theta$pi.c * stats::dbinom(dat$Y, 1, theta$py.c0)
    
    num1 <- theta$pi.c * stats::dbinom(dat$Y, 1, theta$py.c1)  # C,1
    den1 <- theta$pi.at * stats::dbinom(dat$Y, 1, theta$py.at) + theta$pi.c * stats::dbinom(dat$Y, 1, theta$py.c1)
    
    pG <- NULL
    pG[dat$Z == 1 & dat$W == 1] <- num1[dat$Z == 1 & dat$W == 1]/den1[dat$Z == 1 & dat$W == 1]
    pG[dat$Z == 0 & dat$W == 0] <- num0[dat$Z == 0 & dat$W == 0]/den0[dat$Z == 0 & dat$W == 0]
    
    # Expected compliance behavior
    G.c <- G.at <- G.nt <- NULL
    
    G.c[dat$Z == 1 & dat$W == 1] <- pG[dat$Z == 1 & dat$W == 1]
    G.c[dat$Z == 0 & dat$W == 1] <- 0
    G.c[dat$Z == 1 & dat$W == 0] <- 0
    G.c[dat$Z == 0 & dat$W == 0] <- pG[dat$Z == 0 & dat$W == 0]
    
    G.at[dat$Z == 1 & dat$W == 1] <- 1 - pG[dat$Z == 1 & dat$W == 1]
    G.at[dat$Z == 0 & dat$W == 1] <- 1
    G.at[dat$Z == 1 & dat$W == 0] <- 0
    G.at[dat$Z == 0 & dat$W == 0] <- 0
    
    
    G.nt[dat$Z == 1 & dat$W == 1] <- 0
    G.nt[dat$Z == 0 & dat$W == 1] <- 0
    G.nt[dat$Z == 1 & dat$W == 0] <- 1
    G.nt[dat$Z == 0 & dat$W == 0] <- 1 - pG[dat$Z == 0 & dat$W == 0]
    
    G <- cbind(G.nt, G.at, G.c)
    rm(G.nt, G.at, G.c)
    return(G)
}

#' @title Maximization step of the Expectation-Maximization (EM) algorithm to calculate the MLE of the Complier Average Causal Effect (CACE) for binary outcomes
#' @description M.step.bin2() implements the Maximization step of the EM algorithm to calculate the MLE of CACE for binary outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame
#' @param G A vector with the expected compliance status for each unit in the data set
#' @return A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' py.c0, py.c1 = probabilities that the outcome takes on value 1 for compliers under control and under treatment;
#' py.nt = probability that the outcome takes on value 1 for never-takers;
#' py.at = probability that the outcome takes on value 1 for always-takers
#' @export
M.step.bin2 <- function(G, dat) {
    theta <- list()
    theta$pi.nt <- mean(G[, 1])
    theta$pi.at <- mean(G[, 2])
    theta$pi.c <- mean(G[, 3])
    
    theta$py.c0 <- sum(dat$Y * (1 - dat$Z) * G[, 3])/sum((1 - dat$Z) * G[, 3])
    theta$py.c1 <- sum(dat$Y * dat$Z * G[, 3])/sum(dat$Z * G[, 3])
    
    theta$py.nt <- sum(dat$Y * G[, 1])/sum(G[, 1])
    theta$py.at <- sum(dat$Y * G[, 2])/sum(G[, 2])
    
    return(theta)
    
}



#' @title Maximum Likelihood Estimate (MLE) of the Complier Average Causal Effect (CACE) for binary outcomes
#' @description EM.bin2() uses the Expectation-Maximization (EM) algorithm to calculate the MLEs of CACE for binary outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame
#' @param tol The convergence tolerance. 
#' Convergence is reached when the maximum absolute difference between the parameter values on consecutive step is not greater than @tol.
#' Defaults to 1e-04
#' @param maxit The maximum number of iterations. The default is 1000
#' @return  The value of the MLE of CACE for binary outcomes (at either convergence or the last iteration if the maximum number of iterations has been reached before convergence)
#' @export
EM.bin2 <- function(dat, tol = 1e-04, maxit = 1000) {
    
    pi.g <- gtools::rdirichlet(1, c(1, 1, 1))
    theta <- list(pi.nt = pi.g[1], pi.at = pi.g[2], pi.c = pi.g[3], py.nt = stats::rbeta(1, 1, 1), py.at = stats::rbeta(1, 
        1, 1), py.c0 = stats::rbeta(1, 1, 1), py.c1 = stats::rbeta(1, 1, 1))
    rm(pi.g)
    plus <- function(x) {
        yy <- (x + 0.01)
        (x + 0.01) * (yy < 1) + (x - 0.01) * (yy > 1)
    }
    
    theta1 <- lapply(theta, plus)
    
    n.it <- 0
    
    while (max(abs(unlist(theta1) - unlist(theta))) > tol) {
        
        theta1 <- theta
        
        G <- E.step.bin2(theta, dat)
        theta <- M.step.bin2(G, dat)
        
        # Numerical safeguard: if the M-step produces non-finite values
        # (e.g. an empty compliance stratum within a small bandwidth),
        # revert to the last finite estimate and stop iterating.
        if (any(!is.finite(unlist(theta)))) {
            theta <- theta1
            break
        }
        
        n.it <- n.it + 1
        if (n.it == maxit) {
            break
        }
    }
    
    out <- list(theta = theta, G = G, converged = (n.it < maxit))
    CACE.MLE <- theta$py.c1 - theta$py.c0
    return(CACE.MLE)
}

#' @title Data Augmentation (DA) step of Markov Chain Monte Carlo (MCMC) algorithm to derive the posterior median of the 
#' Complier Average Causal Effect (CACE) for binary outcomes
#' @description da.bin2() implements the Data Augmentation (DA) method to impute the compliance status of each unit 
#' for binary outcomes in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' py.c0, py.c1 = probabilities that the outcome takes on value 1 for compliers under control and under treatment;
#' py.nt = probability that the outcome takes on value 1 for never-takers;
#' py.at = probability that the outcome takes on value 1 for always-takers
#' @param dat Data frame
#' @return  A vector with the imputed compliance status for each unit in the data set
#' @export
da.bin2 <- function(theta, dat) {
    
    G <- NULL
    G[dat$Z == 0 & dat$W == 1] <- 2  ##Always - takers
    G[dat$Z == 1 & dat$W == 0] <- 1  ##Never - takers
    
    num <- theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 0 & dat$W == 0], 1, theta$py.c0)
    den <- theta$pi[1] * stats::dbinom(dat$Y[dat$Z == 0 & dat$W == 0], 1, theta$py.nt) + theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 
        0 & dat$W == 0], 1, theta$py.c0)
    
    pc.00 <- num/den
    pc.00[num == 0] <- 0
    u.00 <- stats::rbinom(sum(dat$Z == 0 & dat$W == 0), 1, pc.00)
    
    G[dat$Z == 0 & dat$W == 0] <- 3 * (u.00 == 1) + 1 * (u.00 == 0)
    rm(num, den, pc.00, u.00)
    
    num <- theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 1 & dat$W == 1], 1, theta$py.c1)
    den <- theta$pi[2] * stats::dbinom(dat$Y[dat$Z == 1 & dat$W == 1], 1, theta$py.at) + theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 
        1 & dat$W == 1], 1, theta$py.c1)
    
    pc.11 <- num/den
    pc.11[num == 0] <- 0
    u.11 <- stats::rbinom(sum(dat$Z == 1 & dat$W == 1), 1, pc.11)
    
    G[dat$Z == 1 & dat$W == 1] <- 3 * (u.11 == 1) + 2 * (u.11 == 0)
    
    rm(num, den, pc.11, u.11)
    return(G)
}

#' @title Posterior median of the Complier Average Causal Effect (CACE) for binary outcomes
#' @description mcmc.bin2() uses the Markov Chain Monte Carlo (MCMC) algorithm with the Data Augmentation (DA) method to derive
#' the posterior median of CACE for binary outcomes in the presence of two-sided noncompliance under
#' monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param n.iter A positive integer specifying the number of iterations (including burn-in)
#' @param n.burn A positive integer specifying the number of burn-in iterations
#' @param dat Data frame
#' @return  The value of the posterior median of CACE for binary outcomes 
#' @export
mcmc.bin2 <- function(n.iter, n.burn, dat) {
    
    n.draws <- n.iter - n.burn
    theta.prior <- list(a = c(1, 1, 1), ay.nt = c(1, 1), ay.at = c(1, 1), ay.c0 = c(1, 1), ay.c1 = c(1, 1))
    
    theta <- list(pi = gtools::rdirichlet(1, theta.prior$a), py.nt = stats::rbeta(1, theta.prior$ay.nt[1], theta.prior$ay.nt[2]), 
        py.at = stats::rbeta(1, theta.prior$ay.at[1], theta.prior$ay.at[2]), py.c0 = stats::rbeta(1, theta.prior$ay.c0[1], 
            theta.prior$ay.c0[2]), py.c1 = stats::rbeta(1, theta.prior$ay.c1[1], theta.prior$ay.c1[2]))
    
    THETA <- matrix(0, n.draws, length(unlist(theta)))
    colnames(THETA) <- c("pi.nt", "pi.at", "pi.c", "py.nt", "py.at", "py.c0", "py.c1")
    
    CACE <- NULL
    
    for (j in 1:n.iter) {
        G <- da.bin2(theta, dat)
        thetapriora <- theta.prior$a + c(sum(G == 1), sum(G == 2), sum(G == 3))
        theta$pi <- gtools::rdirichlet(1, thetapriora)
        
        thetaprioraynt1 <- (theta.prior$ay.nt[1] + sum(G == 1 & dat$Y == 1))
        thetaprioraynt2 <- (theta.prior$ay.nt[2] + sum(G == 1 & dat$Y == 0))
        theta$py.nt <- stats::rbeta(1, thetaprioraynt1, thetaprioraynt2)
        
        thetapyat1 <- (theta.prior$ay.at[1] + sum(G == 2 & dat$Y == 1))
        thetapyat2 <- (theta.prior$ay.at[2] + sum(G == 2 & dat$Y == 0))
        theta$py.at <- stats::rbeta(1, thetapyat1, thetapyat2)
        
        thetapyc01 <- (theta.prior$ay.c0[1] + sum(G == 3 & dat$Z == 0 & dat$Y == 1))
        thetapyc02 <- (theta.prior$ay.c0[2] + sum(G == 3 & dat$Z == 0 & dat$Y == 0))
        theta$py.c0 <- stats::rbeta(1, thetapyc01, thetapyc02)
        
        thetapyc11 <- (theta.prior$ay.c1[1] + sum(G == 3 & dat$Z == 1 & dat$Y == 1))
        thetapyc12 <- (theta.prior$ay.c1[2] + sum(G == 3 & dat$Z == 1 & dat$Y == 0))
        theta$py.c1 <- stats::rbeta(1, thetapyc11, thetapyc12)
        
        if (j > n.burn) {
            jj <- j - n.burn
            THETA[jj, ] <- unlist(theta)
            CACE[jj] <- theta$py.c1 - theta$py.c0
        }
    }  # END LOOP OVER j=1,..., n.iter
    
    
    CACE.PM <- stats::median(CACE)
    
    return(CACE.PM)
}


#' @title Data Augmentation (DA) step of Markov Chain Monte Carlo (MCMC) algorithm to derive the posterior median of the 
#' Complier Average Causal Effect (CACE) for a binary outcome under the sharp null hypothesis of no effect
#' @description da.bin.h02() implements the Data Augmentation (DA) method to impute the compliance status of each unit 
#' for binary outcomes in the presence of two-sided noncompliance 
#' under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers and
#' under the sharp null hypothesis of no effect 
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' py.c = probability that the outcome takes on value 1 for compliers;
#' py.nt = probability that the outcome takes on value 1 for never-takers
#' py.at = probability that the outcome takes on value 1 for always-takers
#' @param dat Data frame
#' @return  A vector with the imputed compliance status for each unit in the data set under the sharp null hypothesis of no effect
#' @export
da.bin.h02 <- function(theta, dat) {
    
    G <- NULL
    G[dat$Z == 0 & dat$W == 1] <- 2  ##Always - takers
    G[dat$Z == 1 & dat$W == 0] <- 1  ##Never - takers
    
    num <- theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 0 & dat$W == 0], 1, theta$py.c)
    den <- theta$pi[1] * stats::dbinom(dat$Y[dat$Z == 0 & dat$W == 0], 1, theta$py.nt) + theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 
        0 & dat$W == 0], 1, theta$py.c)
    
    pc.00 <- num/den
    u.00 <- stats::rbinom(sum(dat$Z == 0 & dat$W == 0), 1, pc.00)
    
    G[dat$Z == 0 & dat$W == 0] <- 3 * (u.00 == 1) + 1 * (u.00 == 0)
    rm(num, den, pc.00, u.00)
    
    num <- theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 1 & dat$W == 1], 1, theta$py.c)
    den <- theta$pi[2] * stats::dbinom(dat$Y[dat$Z == 1 & dat$W == 1], 1, theta$py.at) + theta$pi[3] * stats::dbinom(dat$Y[dat$Z == 
        1 & dat$W == 1], 1, theta$py.c)
    pc.11 <- num/den
    u.11 <- stats::rbinom(sum(dat$Z == 1 & dat$W == 1), 1, pc.11)
    
    G[dat$Z == 1 & dat$W == 1] <- 3 * (u.11 == 1) + 2 * (u.11 == 0)
    
    rm(num, den, pc.11, u.11)
    return(G)
}

#' @title Posterior distributions of the parameter vector and the compliance status of each unit for a binary outcome
#' under the sharp null hypothesis of no effect
#' @description mcmc.bin.h02() uses the Markov Chain Monte Carlo (MCMC) algorithm with the Data Augmentation (DA) method to derive
#' the posterior median of CACE for a binary outcome in the presence of two-sided noncompliance 
#' under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers and
#' under the sharp null hypothesis of no effect
#' @param n.iter A positive integer specifying the number of iterations (including burn-in)
#' @param n.burn A positive integer specifying the number of burn-in iterations
#' @param dat Data frame
#' @return  A list of two elements:
#' THETA = a matrix with the simulated posterior distribution of the parameter vector for a binary outcome under the sharp null hypothesis of no effect 
#' Gstatus = a matrix with simulated posterior distribution of the compliance status of each unit under the sharp null hypothesis of no effect 
#' @export
mcmc.bin.h02 <- function(n.iter, n.burn, dat) {
    
    n.draws <- n.iter - n.burn
    theta.prior <- list(a = c(1, 1, 1), ay.nt = c(1, 1), ay.at = c(1, 1), ay.c = c(1, 1))
    
    theta <- list(pi = gtools::rdirichlet(1, theta.prior$a), py.nt = stats::rbeta(1, theta.prior$ay.nt[1], theta.prior$ay.nt[2]), 
        py.at = stats::rbeta(1, theta.prior$ay.at[1], theta.prior$ay.at[2]), py.c = stats::rbeta(1, theta.prior$ay.c[1], 
            theta.prior$ay.c[2]))
    
    
    THETA <- matrix(0, n.draws, length(unlist(theta)))
    colnames(THETA) <- c("pi.nt", "pi.at", "pi.c", "py.nt", "py.at", "py.c")
    Gstatus <- matrix(0, n.draws, nrow(dat))
    
    for (j in 1:n.iter) {
        G <- da.bin.h02(theta, dat)
        theta$pi <- gtools::rdirichlet(1, (theta.prior$a + c(sum(G == 1), sum(G == 2), sum(G == 3))))
        
        theta$py.nt <- stats::rbeta(1, (theta.prior$ay.nt[1] + sum(G == 1 & dat$Y == 1)), (theta.prior$ay.nt[2] + sum(G == 
            1 & dat$Y == 0)))
        
        theta$py.at <- stats::rbeta(1, (theta.prior$ay.at[1] + sum(G == 2 & dat$Y == 1)), (theta.prior$ay.at[2] + sum(G == 
            2 & dat$Y == 0)))
        
        theta$py.c <- stats::rbeta(1, (theta.prior$ay.c[1] + sum(G == 3 & dat$Y == 1)), (theta.prior$ay.c[2] + sum(G == 
            3 & dat$Y == 0)))
        
        if (j > n.burn) {
            jj <- j - n.burn
            THETA[jj, ] <- unlist(theta)
            Gstatus[jj, ] <- G
        }
        
    }  # END LOOP OVER j=1,..., n.iter
    
    list(THETA = THETA, Gstatus = Gstatus)
}



#' @title Expectation step of the Expectation-Maximization (EM) algorithm to calculate the MLE of the Complier Average Causal Effect (CACE) for Gaussian outcomes
#' @description E.step.gauss2() implements the Expectation step of the EM algorithm to calculate the MLE of CACE for continuous normally distributed outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' mu.c0, sigma2.c0, mu.c1, sigma2.c1 = means and variances of the Normal distributions of the outcome for compliers under control and under treatment;
#' mu.nt, sigma2.nt = mean and variance of the Normal distribution of the outcome for never-takers;
#' mu.at, sigma2.at = mean and variance of the Normal distribution of the outcome for always-takers
#' @return  A vector with the expected compliance status for each unit in the data set
#' @export
E.step.gauss2 <- function(theta, dat) {
    
    num0 <- theta$pi.c * stats::dnorm(dat$Y, theta$mu.c0, sqrt(theta$sigma2.c0))  # C,0
    den0 <- theta$pi.nt * stats::dnorm(dat$Y, theta$mu.nt, sqrt(theta$sigma2.nt)) + theta$pi.c * stats::dnorm(dat$Y, 
        theta$mu.c0, sqrt(theta$sigma2.c0))
    
    num1 <- theta$pi.c * stats::dnorm(dat$Y, theta$mu.c1, sqrt(theta$sigma2.c1))  # C,1
    den1 <- theta$pi.at * stats::dnorm(dat$Y, theta$mu.at, sqrt(theta$sigma2.at)) + theta$pi.c * stats::dnorm(dat$Y, 
        theta$mu.c1, sqrt(theta$sigma2.c1))
    
    pG <- NULL
    pG[dat$Z == 0 & dat$W == 0] <- num0[dat$Z == 0 & dat$W == 0]/den0[dat$Z == 0 & dat$W == 0]
    pG[dat$Z == 1 & dat$W == 1] <- num1[dat$Z == 1 & dat$W == 1]/den1[dat$Z == 1 & dat$W == 1]
    
    G <- matrix(0, nrow(dat), 3)
    
    G[dat$Z == 1 & dat$W == 1, 1] <- 0
    G[dat$Z == 1 & dat$W == 0, 1] <- 1
    G[dat$Z == 0 & dat$W == 1, 1] <- 0
    G[dat$Z == 0 & dat$W == 0, 1] <- 1 - pG[dat$Z == 0 & dat$W == 0]
    
    G[dat$Z == 1 & dat$W == 1, 2] <- 1 - pG[dat$Z == 1 & dat$W == 1]
    G[dat$Z == 1 & dat$W == 0, 2] <- 0
    G[dat$Z == 0 & dat$W == 1, 2] <- 1
    G[dat$Z == 0 & dat$W == 0, 2] <- 0
    
    G[dat$Z == 1 & dat$W == 1, 3] <- pG[dat$Z == 1 & dat$W == 1]
    G[dat$Z == 1 & dat$W == 0, 3] <- 0
    G[dat$Z == 0 & dat$W == 1, 3] <- 0
    G[dat$Z == 0 & dat$W == 0, 3] <- pG[dat$Z == 0 & dat$W == 0]
    
    return(G)
}


#' @title Maximization step of the Expectation-Maximization (EM) algorithm to calculate the MLE of the Complier Average Causal Effect (CACE) for Gaussian outcomes
#' @description M.step.gauss2() implements the Maximization step of the EM algorithm to calculate the MLE of CACE for continuous normally distributed outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame
#' @param G  A vector with the expected compliance status for each unit in the data set
#' @return A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' mu.c0, sigma2.c0, mu.c1, sigma2.c1 = means and variances of the Normal distributions of the outcome for compliers under control and under treatment;
#' mu.nt, sigma2.nt = mean and variance of the Normal distribution of the outcome for never-takers;
#' mu.at, sigma2.at = mean and variance of the Normal distribution of the outcome for always-takers
#' @export
M.step.gauss2 <- function(G, dat) {
    theta <- list()
    theta$pi.nt <- mean(G[, 1])
    theta$pi.at <- mean(G[, 2])
    theta$pi.c <- mean(G[, 3])
    
    theta$mu.c0 <- sum(dat$Y * (1 - dat$Z) * G[, 3])/sum((1 - dat$Z) * G[, 3])
    theta$mu.c1 <- sum(dat$Y * dat$Z * G[, 3])/sum(dat$Z * G[, 3])
    theta$mu.nt <- sum(dat$Y * G[, 1])/sum(G[, 1])
    theta$mu.at <- sum(dat$Y * G[, 2])/sum(G[, 2])
    
    theta$sigma2.c0 <- sum((dat$Y - theta$mu.c0)^2 * (1 - dat$Z) * G[, 3])/sum((1 - dat$Z) * G[, 3])  # C,0
    theta$sigma2.c1 <- sum((dat$Y - theta$mu.c1)^2 * dat$Z * G[, 3])/sum(dat$Z * G[, 3])  # C,1
    theta$sigma2.nt <- sum((dat$Y - theta$mu.nt)^2 * G[, 1])/sum(G[, 1])
    theta$sigma2.at <- sum((dat$Y - theta$mu.at)^2 * G[, 2])/sum(G[, 2])
    return(theta)
    
}

#' @title Maximum Likelihood Estimate (MLE) of the Complier Average Causal Effect (CACE) for Gaussian outcomes
#' @description EM.gauss2() uses the Expectation-Maximization (EM) algorithm to calculate the MLEs of CACE for continuous normally distributed outcomes 
#' in the presence of two-sided noncompliance under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param dat Data frame 
#' @param tol The convergence tolerance
#' Convergence is reached when the maximum absolute difference between the parameter values on consecutive step is not greater than @tol
#' The default is 1e-04
#' @param maxit The maximum number of iterations. The default is 1000
#' @return  The value of the MLE of CACE for continuous outcomes (at either convergence or the last iteration if the maximum number of iterations has been reached before convergence)
#' @export
EM.gauss2 <- function(dat, tol = 1e-04, maxit = 1000) {
    
    pi.g <- gtools::rdirichlet(1, c(1, 1, 1))
    theta <- list(pi.nt = pi.g[1], pi.at = pi.g[2], pi.c = pi.g[3], mu.nt = mean(dat$Y) + stats::rnorm(1, 0, stats::sd(dat$Y)), 
        sigma2.nt = stats::runif(1, 0, stats::var(dat$Y)), mu.at = mean(dat$Y) + stats::rnorm(1, 0, stats::sd(dat$Y)), 
        sigma2.at = stats::runif(1, 0, stats::var(dat$Y)), mu.c0 = mean(dat$Y) + stats::rnorm(1, 0, stats::sd(dat$Y)), 
        sigma2.c0 = stats::runif(1, 0, stats::var(dat$Y)), mu.c1 = mean(dat$Y) + stats::rnorm(1, 0, stats::sd(dat$Y)), 
        sigma2.c1 = stats::runif(1, 0, stats::var(dat$Y)))
    
    plus <- function(x) {
        yy <- x + 1
        return(yy)
    }
    
    theta1 <- lapply(theta, plus)
    
    n.it <- 0
    
    while (max(abs(unlist(theta1) - unlist(theta))) > tol) {
        
        theta1 <- theta
        
        G <- E.step.gauss2(theta, dat)
        theta <- M.step.gauss2(G, dat)
        
        # Numerical safeguard: if the M-step produces non-finite values
        # (e.g. an empty compliance stratum within a small bandwidth),
        # revert to the last finite estimate and stop iterating.
        if (any(!is.finite(unlist(theta)))) {
            theta <- theta1
            break
        }
        
        n.it <- n.it + 1
        if (n.it == maxit) {
            break
        }
    }
    
    out <- list(theta = theta, G = G, converged = (n.it < maxit))
    CACE.MLE <- theta$mu.c1 - theta$mu.c0
    return(CACE.MLE)
}

#' @title Data Augmentation (DA) step of Markov Chain Monte Carlo (MCMC) algorithm to derive the posterior median of the 
#' Complier Average Causal Effect (CACE) for Gaussian outcomes
#' @description da.gauss2() implements the Data Augmentation (DA) method to impute the compliance status of each unit 
#' for normally distributed outcomes in the presence of two-sided noncompliance under 
#' monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' mu.c0, sigma2.c0, mu.c1, sigma2.c1 = means and variances of the Normal distributions of the outcome for compliers under control and under treatment;
#' mu.nt, sigma2.nt = mean and variance of the Normal distribution of the outcome for never-takers;
#' mu.at, sigma2.at = mean and variance of the Normal distribution of the outcome for always-takers
#' @param dat Data frame
#' @return  A vector with the imputed compliance status for each unit in the data set
#' @export
da.gauss2 <- function(theta, dat) {
    
    G <- NULL
    G[dat$Z == 0 & dat$W == 1] <- 2  ##AT
    G[dat$Z == 1 & dat$W == 0] <- 1  ##Never - takers
    
    num <- theta$pi[3] * stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.c0, sqrt(theta$sigma2.c0))
    den <- theta$pi[1] * stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.nt, sqrt(theta$sigma2.nt)) + theta$pi[3] * 
        stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.c0, sqrt(theta$sigma2.c0))
    
    pc.00 <- num/den
    pc.00[num == 0] <- 0
    u.00 <- stats::rbinom(sum(dat$Z == 0 & dat$W == 0), 1, pc.00)
    G[dat$Z == 0 & dat$W == 0] <- 3 * (u.00 == 1) + 1 * (u.00 == 0)
    
    rm(num, den, pc.00, u.00)
    
    num <- theta$pi[3] * stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.c1, sqrt(theta$sigma2.c1))
    den <- theta$pi[2] * stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.at, sqrt(theta$sigma2.at)) + theta$pi[3] * 
        stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.c1, sqrt(theta$sigma2.c1))
    
    pc.11 <- num/den
    pc.11[num == 0] <- 0
    u.11 <- stats::rbinom(sum(dat$Z == 1 & dat$W == 1), 1, pc.11)
    G[dat$Z == 1 & dat$W == 1] <- 3 * (u.11 == 1) + 2 * (u.11 == 0)
    
    rm(num, den, pc.11, u.11)
    
    return(G)
}


#' @title Posterior median of the Complier Average Causal Effect (CACE) for Gaussian outcomes
#' @description mcmc.gauss2() uses the Markov Chain Monte Carlo (MCMC) algorithm with the Data Augmentation (DA) method to derive
#' the posterior median of CACE for normally distributed outcomes in the presence of two-sided noncompliance under 
#' monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' @param n.iter A positive integer specifying the number of iterations (including burn-in)
#' @param n.burn A positive integer specifying the number of burn-in iterations
#' @param dat Data frame 
#' @return  The value of the posterior median of CACE for Gaussian outcomes 
#' @export
mcmc.gauss2 <- function(n.iter, n.burn, dat) {
    
    n.draws <- n.iter - n.burn
    theta.prior <- list(a = c(1, 1, 1))
    
    theta <- list(pi = gtools::rdirichlet(1, c(1, 1, 1)), mu.nt = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.nt = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)), mu.at = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.at = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)), mu.c0 = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.c0 = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)), mu.c1 = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.c1 = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)))
    
    THETA <- matrix(0, n.draws, length(unlist(theta)))
    colnames(THETA) <- c("pi.nt", "pi.at", "pi.c", "mu.nt", "sigma2.nt", "mu.at", "sigma2.at", "mu.c0", "sigma2.c0", 
        "mu.c1", "sigma2.c1")
    
    CACE <- NULL
    
    for (j in 1:n.iter) {
        
        G <- da.gauss2(theta, dat)
        theta$pi <- gtools::rdirichlet(1, c((theta.prior$a[1] + sum(G == 1)), (theta.prior$a[2] + sum(G == 2)), (theta.prior$a[3] + 
            sum(G == 3))))
        
        n.nt <- sum(G == 1)
        s2.nt <- stats::var(dat$Y[G == 1])
        theta$sigma2.nt <- ((n.nt - 1) * s2.nt)/stats::rchisq(1, df = (n.nt - 1))
        theta$mu.nt <- stats::rnorm(1, mean = mean(dat$Y[G == 1]), sd = sqrt(theta$sigma2.nt/n.nt))
        rm(n.nt, s2.nt)
        
        n.at <- sum(G == 2)
        s2.at <- stats::var(dat$Y[G == 2])
        theta$sigma2.at <- ((n.at - 1) * s2.at)/stats::rchisq(1, df = (n.at - 1))
        theta$mu.at <- stats::rnorm(1, mean = mean(dat$Y[G == 2]), sd = sqrt(theta$sigma2.at/n.at))
        rm(n.at, s2.at)
        
        n.c0 <- sum(G == 3 & dat$Z == 0)
        s2.c0 <- stats::var(dat$Y[G == 3 & dat$Z == 0])
        theta$sigma2.c0 <- ((n.c0 - 1) * s2.c0)/stats::rchisq(1, df = (n.c0 - 1))
        theta$mu.c0 <- stats::rnorm(1, mean = mean(dat$Y[G == 3 & dat$Z == 0]), sd = sqrt(theta$sigma2.c0/n.c0))
        rm(n.c0, s2.c0)
        
        n.c1 <- sum(G == 3 & dat$Z == 1)
        s2.c1 <- stats::var(dat$Y[G == 3 & dat$Z == 1])
        theta$sigma2.c1 <- ((n.c1 - 1) * s2.c1)/stats::rchisq(1, df = (n.c1 - 1))
        theta$mu.c1 <- stats::rnorm(1, mean = mean(dat$Y[G == 3 & dat$Z == 1]), sd = sqrt(theta$sigma2.c1/n.c1))
        rm(n.c1, s2.c1)
        
        if (j > n.burn) {
            jj <- j - n.burn
            THETA[jj, ] <- unlist(theta)
            CACE[jj] <- theta$mu.c1 - theta$mu.c0
        }
    }  # END LOOP OVER j=1,..., n.iter
    
    
    CACE.PM <- stats::median(CACE)
    
    return(CACE.PM)
    
}

#' @title Data Augmentation (DA) step of Markov Chain Monte Carlo (MCMC) algorithm to derive the posterior median of the 
#' Complier Average Causal Effect (CACE) for a Gaussian outcome under the sharp null hypothesis of no effect
#' @description da.gauss.h02() implements the Data Augmentation (DA) method to impute the compliance status of each unit 
#' for a continuous normally distributed outcome in the presence of two-sided noncompliance 
#' under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers and under the sharp null hypothesis of no effect
#' @param theta A list with the values of the parameters: 
#' pi.c = proportion of compliers;
#' mu.c, sigma2.c = means and variances of the Normal distribution of the outcome for compliers;
#' mu.nt, sigma2.nt = mean and variance of the Normal distribution of the outcome for never-takers;
#' mu.at, sigma2.at = mean and variance of the Normal distribution of the outcome for always-takers
#' @param dat Data frame
#' @return  A vector with the imputed compliance status for each unit in the data set under the sharp null hypothesis of no effect 
#' @export
da.gauss.h02 <- function(theta, dat) {
    
    G <- NULL
    G[dat$Z == 1 & dat$W == 0] <- 1  ##Never - takers
    G[dat$Z == 0 & dat$W == 1] <- 2  ##Always - takers
    
    num <- theta$pi[3] * stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.c, sqrt(theta$sigma2.c))
    den <- theta$pi[1] * stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.nt, sqrt(theta$sigma2.nt)) + theta$pi[3] * 
        stats::dnorm(dat$Y[dat$Z == 0 & dat$W == 0], theta$mu.c, sqrt(theta$sigma2.c))
    
    pc.00 <- num/den
    pc.00[num == 0] <- 0
    u.00 <- stats::rbinom(sum(dat$Z == 0 & dat$W == 0), 1, pc.00)
    G[dat$Z == 0 & dat$W == 0] <- 3 * (u.00 == 1) + 1 * (u.00 == 0)
    
    rm(num, den, pc.00, u.00)
    
    num <- theta$pi[3] * stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.c, sqrt(theta$sigma2.c))
    den <- theta$pi[2] * stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.at, sqrt(theta$sigma2.at)) + theta$pi[3] * 
        stats::dnorm(dat$Y[dat$Z == 1 & dat$W == 1], theta$mu.c, sqrt(theta$sigma2.c))
    
    pc.11 <- num/den
    pc.11[num == 0] <- 0
    u.11 <- stats::rbinom(sum(dat$Z == 1 & dat$W == 1), 1, pc.11)
    G[dat$Z == 1 & dat$W == 1] <- 3 * (u.11 == 1) + 2 * (u.11 == 0)
    
    rm(num, den, pc.11, u.11)
    
    return(G)
}


#' @title Posterior distributions of the parameter vector and the compliance status of each unit for a Gaussian outcome 
#' under the sharp null hypothesis of no effect 
#' @description mcmc.gauss.h02() uses the Markov Chain Monte Carlo (MCMC) algorithm with the Data Augmentation (DA) method to derive
#' the posterior median of CACE for a normally distributed outcome in the presence of two-sided noncompliance 
#' under monotonicity (no defiers) and exclusion restrictions for both never-takers and always-takers
#' and under the sharp null hypothesis of no effect
#' @param n.iter A positive integer specifying the number of iterations (including burn-in)
#' @param n.burn A positive integer specifying the number of burn-in iterations
#' @param dat Data frame
#' @return  A list of two elements:
#' THETA = a matrix with the simulated posterior distribution of the parameter vector for a Gaussian outcome under the sharp null hypothesis of no effect 
#' Gstatus = a matrix with simulated posterior distribution of the compliance status of each unit under the sharp null hypothesis of no effect
#' @export
mcmc.gauss.h02 <- function(n.iter, n.burn, dat) {
    
    n.draws <- n.iter - n.burn
    theta.prior <- list(a = c(1, 1, 1))
    
    theta <- list(pi.c = gtools::rdirichlet(1, c(1, 1, 1)), mu.nt = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.nt = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)), mu.at = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.at = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)), mu.c = mean(dat$Y) + stats::rnorm(1, 0, 1), sigma2.c = stats::runif(1, 
        stats::var(dat$Y)/2, 2 * stats::var(dat$Y)))
    THETA <- matrix(0, n.draws, length(unlist(theta)))
    colnames(THETA) <- c("pi.nt", "pi.at", "pi.c", "mu.nt", "sigma2.nt", "mu.at", "sigma2.at", "mu.c", "sigma2.c")
    Gstatus <- matrix(0, n.draws, nrow(dat))
    
    for (j in 1:n.iter) {
        G <- da.gauss.h02(theta, dat)
        theta$pi.c <- gtools::rdirichlet(1, c((theta.prior$a[1] + sum(G == 1)), (theta.prior$a[2] + sum(G == 2)), (theta.prior$a[3] + 
            sum(G == 3))))
        
        n.nt <- sum(G == 1)
        s2.nt <- stats::var(dat$Y[G == 1])
        theta$sigma2.nt <- ((n.nt - 1) * s2.nt)/stats::rchisq(1, df = (n.nt - 1))
        theta$mu.nt <- stats::rnorm(1, mean = mean(dat$Y[G == 1]), sd = sqrt(theta$sigma2.nt/n.nt))
        rm(n.nt, s2.nt)
        
        n.at <- sum(G == 2)
        s2.at <- stats::var(dat$Y[G == 2])
        theta$sigma2.at <- ((n.at - 1) * s2.at)/stats::rchisq(1, df = (n.at - 1))
        theta$mu.at <- stats::rnorm(1, mean = mean(dat$Y[G == 2]), sd = sqrt(theta$sigma2.at/n.at))
        rm(n.at, s2.at)
        
        n.c <- sum(G == 1)
        s2.c <- stats::var(dat$Y[G == 3])
        theta$sigma2.c <- ((n.c - 1) * s2.c)/stats::rchisq(1, df = (n.c - 1))
        theta$mu.c <- stats::rnorm(1, mean = mean(dat$Y[G == 3]), sd = sqrt(theta$sigma2.c/n.c))
        rm(n.c, s2.c)
        
        
        if (j > n.burn) {
            jj <- j - n.burn
            THETA[jj, ] <- unlist(theta)
            Gstatus[jj, ] <- G
        }
        
    }  # END LOOP OVER j=1,..., n.iter
    
    list(THETA = THETA, Gstatus = Gstatus)
}





