

#' @title Randomization-based tests adjusted for multiple testing
#' @description rand_pajd() calculates, for each of the selected variables and in the selected subpopulation the meand difference and adjusted p-value.
#' @param dataset The data frame with the variables 
#' @param forcing_var_name The name of the forcing variable in the dataset.
#' @param covariates Covariates of the model.
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth Selected range to subset the dataset and create the subpopulation of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @return A data frame with the selected variables and the correponding mean difference with adjusted p-value. 
#' @details The table shows the mean difference of each variable between treatment groups, and the corresponding p-value derived using randomization-based tests adjusted for multiple testing. 
#' @export
#' @examples  
#' \donttest{
#' data(grants)
#' rand_pajd(dataset = grants, forcing_var_name = 'S', 
#' covariates = c('sex', 'HSHumanity', 'HSTech', 'HSOther', 
#' 'hsgrade', 'Y2004'), niter = 1000, bandwidth = 1000, 
#' cut_value = 15000, whichunder = 1)
#' }
rand_pajd <- function(dataset, forcing_var_name = "S", covariates = c("sex", "HSHumanity", "HSTech", "HSOther", "hsgrade", 
    "Y2004"), niter = 1000, bandwidth = 1000, cut_value = 15000, whichunder = 1) {
    
    s0 <- cut_value
    S <- dataset[, forcing_var_name]
    
    if (whichunder == 0) {
        Z <- ifelse(S >= s0, 0, 1)
    } else if (whichunder == 1) {
        Z <- ifelse(S >= s0, 1, 0)
    }
    
    X <- data.frame(dataset[, covariates])
    
    h <- bandwidth
    K <- niter
    M <- K
    
    dataset.h <- dataset[S >= s0 - h & S <= s0 + h, ]
    
    Nh <- nrow(dataset.h)
    
    
    Sh <- dataset.h[, forcing_var_name]
    
    if (whichunder == 0) {
        Zh <- ifelse(Sh >= s0, 0, 1)
    } else if (whichunder == 1) {
        Zh <- ifelse(Sh >= s0, 1, 0)
    }
    
    Xh <- data.frame(dataset.h[, covariates])
    
    Th.obs <- apply(Xh, 2, Tave, Zh)
    p.values.obs <- matrix(0, K, ncol(Xh))
    Th.HYP <- matrix(0, K, ncol(Xh))
    
    for (j in 1:K) {
        Zh.hyp <- sample(Zh, Nh, replace = TRUE)
        Th.hyp <- apply(Xh, 2, Tave, Zh.hyp)
        p.values.obs[j, ] <- as.numeric(Th.hyp >= Th.obs)
        Th.HYP[j, ] <- Th.hyp
        rm(Zh.hyp, Th.hyp)
    }
    Pvalues.obs <- apply(p.values.obs, 2, mean)
    
    Pvalues.hyp.obs <- rep(0, M)
    Adj.pvalues <- matrix(0, M, ncol(Xh))
    
    for (j in 1:M) {
        Th.hyp.obs <- matrix(Th.HYP[j, ], (K - 1), ncol(Xh), byrow = T)
        Pvalues.hyp <- apply(Th.hyp.obs >= Th.HYP[-j, ], 2, mean)
        Pvalues.hyp.obs[j] <- min(Pvalues.hyp)
        rm(Pvalues.hyp)
        Adj.pvalues[j, ] <- 1 * (Pvalues.hyp.obs[j] <= Pvalues.obs)
    }
    
    adj.pvalues <- apply(Adj.pvalues, 2, mean)
    
    names(adj.pvalues) <- names(X)
    dff <- data.frame(names(adj.pvalues), Pvalues.obs, adj.pvalues)
    names(dff)[1] <- c("Variables")
    rownames(dff) <- NULL
    
    return(dff)
    
}




#' @title Bandwidth selection for Randomization-based tests adjusted for multiple testing
#' @description Randomization-based tests adjusted for multiple testing (rand_pajd function) was defined to calculate just for one bandwidth. For the cases where the user wants to test several bandwidths this functions is applied. 
#' @param dataset The data frame with the variables 
#' @param forcing_var_name The name of the forcing variable in the dataset.
#' @param covariates Covariates of the model.
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth A numerical vector defining the ranges to subset the dataset and create the subpopulations of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @return A data frame with the selected variables and bandwidths, and the correponding mean difference with adjusted p-value. 
#' @export
#' @examples  
#' \donttest{
#' data(grants)
#' rand_pajd_bw(dataset = grants, forcing_var_name = 'S', 
#' covariates = c('sex', 'HSHumanity', 'HSTech', 'HSOther', 
#' 'hsgrade', 'Y2004'), niter = 1000, 
#' bandwidth = c(500, 1000, 5000), cut_value = 15000, 
#' whichunder = 1)
#' }
rand_pajd_bw <- function(dataset, forcing_var_name = "S", covariates = c("sex", "HSHumanity", "HSTech", "HSOther", "hsgrade", 
    "Y2004"), niter = 1000, bandwidth = c(500, 1000, 5000), cut_value = 15000, whichunder = 1) {
    s0 <- cut_value
    S <- dataset[, forcing_var_name]  #Forcing variable
    
    if (whichunder == 0) {
        Z <- ifelse(S >= s0, 0, 1)
    } else if (whichunder == 1) {
        Z <- ifelse(S >= s0, 1, 0)
    }
    
    X <- dataset[, covariates]
    
    lenbw <- length(bandwidth)
    ss2 <- NULL
    namesbuffer <- NULL
    
    for (h in 1:lenbw) {
        
        ss <- rand_pajd(dataset, forcing_var_name = forcing_var_name, covariates = covariates, niter = niter, bandwidth = bandwidth[h], 
            cut_value = cut_value, whichunder = whichunder)
        ss <- as.vector(ss[, 3])
        ss2 <- c(ss2, ss)
        namesbuffer <- c(namesbuffer, paste0("p-value[Bandwidth=", bandwidth[h], "]"))
    }
    
    df <- data.frame(matrix(ss2, length(covariates), lenbw))
    df2 <- data.frame(covariates, df)
    names(df2) <- c("Names", namesbuffer)
    return(df2)
}



#' @title Calculate Fisher Exact p-value
#' @description  sharp_fep implements the Fisher exact p?\210?value approach (Fisher 1925) for drawing inference on causal effects in the dataset
#' @param dataset The data frame with the variables 
#' @param forcing_bin_var_name The name of the forcing variable in a binary format in the dataset.
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @details This approach is randomization-based mode of inference because it assumes randomized experiments: it treats the potential outcome as fixed unknown quantities, viewing the assignment variable, Si, and thus, treatment assignment, Zi, as the only source of randomness. Randomization-based modes of inference, not relying on asymptotic approximations, are particularly attractive in RD settings where the analysis may depend on small samplesize. We implement the Fisher exactp?\210?value approach focusing on assessing the sharp (exact) null hypothesis of no effect of the treatment whatsoever, that is, the null hypothesis under which,for each unit in theUs0, both values of the potential outcomes are identical.
#' @return A data frame the correponding effect of the selection. 
#' @export
#' @examples  
#' \donttest{
#' data(grants)
#' sharp_fep(dataset = grants, forcing_bin_var_name = 'Z', 
#' Y_name = 'dropout', niter = 100)
#' }
sharp_fep <- function(dataset, forcing_bin_var_name = "Z", Y_name = "dropout", niter = 100) {
    M <- niter
    Y <- as.numeric(dataset[, Y_name])
    Z <- dataset[, forcing_bin_var_name]
    
    m1 <- mean(Y[dataset[, forcing_bin_var_name] == 1])
    m0 <- mean(Y[dataset[, forcing_bin_var_name] == 0])
    tave <- m1 - m0
    tobs <- abs(tave)
    Nh <- length(Y)
    
    thyp.m <- 0
    p.value <- 0
    for (m in 1:M) {
        Z.m <- sample(Z, Nh, replace = TRUE)
        thyp.m <- c(thyp.m, abs(mean(Y[Z.m == 1]) - mean(Y[Z.m == 0])))
        p.value <- p.value + as.numeric(thyp.m[m + 1] >= tobs)
    }
    p.value <- p.value/M
    thyp.m <- thyp.m[-1]
    res1 <- c(Nh, tave, tobs, p.value)
    res1 <- data.frame(res1)
    res1 <- data.frame(c("Nh", "tave", "tobs", "p.value"), res1)
    names(res1) <- c("Variable", "Value")
    return(list(res1 = res1, thyp.m = thyp.m))
}



#' @title Bandwidth selection for Fisher Exact p-value
#' @description shar_fep() was defined to calculate just for one dataset. For the cases where the user wants to test several bandwidths this functions is applied. 
#' @param dataset The data frame with the variables 
#' @param forcing_var_name The name of the forcing variable in the dataset.
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth A numerical vector defining the ranges to subset the dataset and create the subpopulations of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @return A data frame with the selected bandwidths and the correponding effect. 
#' @export
sharp_fep_bw <- function(dataset, forcing_var_name = "S", Y_name = "dropout", niter = 1000, bandwidth = c(500, 1000, 
    1500), cut_value = 15000, whichunder = 1) {
    
    len_bw <- length(bandwidth)
    
    s0 <- cut_value
    if (whichunder == 1) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 1, 0)
    } else if (whichunder == 0) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 0, 1)
    }
    
    Sh <- dataset[, forcing_var_name]
    pbalioak <- c()
    nak <- c()
    
    hist_data <- list()
    
    for (b in 1:len_bw) {
        
        h <- bandwidth[b]/2
        
        dat_bw <- dataset[Sh >= s0 - h & Sh <= s0 + h, ]
        
        N <- dim(dat_bw)[1]
        
        ft <- sharp_fep(dataset = dat_bw, forcing_bin_var_name = "assigVar", Y_name = Y_name, niter = 1000)
        pbalioak <- c(pbalioak, ft$res1[, 2])
        hist_data[[b]] <- ft$thyp.m
        
    }
    
    dfp <- data.frame(matrix(pbalioak, ncol = 4, byrow = T))
    dfp[, 2:3] <- round(dfp[, 2:3], 4)
    
    df <- cbind(bandwidth, dfp)
    names(df) <- c("Bandwidth", "N", "Difference in average outcomes by treatment status
Statistic", "Absolute value of difference in average outcomes", 
        "p-value")
    return(list(df = df, hist_data = hist_data))
    
}


#' @title SHARP RDD: RANDOMIZATION-BASED INFERENCE - NEYMAN APPROACH
#' @description sharp_neyman() implements the Neyman approach (Neyman 1923, 1990) for drawing inference on causal effects in the dataset
#' @param Y A numerical vector with the data about the outcome
#' @param Z forcing binary variable
#' @param cin Alpha level for the confidence intervals (e.g. the default 0.05 yields 95\% confidence intervals)
#' @details When the Neyman approach is used for inference, the function calculate the estimate of the average causal effect in this Equation (1) derived using the estimator proposed by Neyman,that is, the difference between the observed averages for units exposed to treatment and units exposed to control. 
#' @return A vector with values for the effect and the confidence intervals.
#' @export
sharp_neyman <- function(Y, Z, cin) {
    
    Y = as.numeric(Y)
    Z = as.numeric(Z)
    
    m1 <- mean(Y[Z == 1])
    m0 <- mean(Y[Z == 0])
    
    tau <- m1 - m0
    tau
    
    if (length(table(Y)) == 2) {
        Vneyman <- (m1 * (1 - m1))/sum(Z == 1) + (m0 * (1 - m0))/sum(Z == 0)
        
    } else if (length(table(Y)) > 2) {
        Vneyman <- (stats::var(Y[Z == 1]))/sum(Z == 1) + (stats::var(Y[Z == 0]))/sum(Z == 0)
    }
    Vneyman
    
    cig <- 1 - cin/2
    
    zz <- stats::qnorm(cig)
    tau - zz * sqrt(Vneyman)
    tau + zz * sqrt(Vneyman)
    
    vector <- c(length(Y), tau, sqrt(Vneyman), tau - zz * sqrt(Vneyman), tau + zz * sqrt(Vneyman))
    return(vector)
}


#' @title Bandwidth selection for Sharp - neyman approach
#' @description sharp_neyman() was defined to calculate just for one dataset. For the cases where the user wants to test several bandwidths this functions is applied. 
#' @param dataset The dataset with the variables
#' @param forcing_var_name forcing_var_name
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth A numerical vector defining the ranges to subset the dataset and create the subpopulations of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @details We focus on the sharp null hypothesis of no effect of assignment of treatment on outcome: H0:Yi(0) =Yi(1)for alli ?\210\210 Us0
#' @param cin Alpha level for the confidence intervals (e.g. the default 0.05 yields 95\% confidence intervals)
#' @return data frame with variable and value and bandwidth
#' @export
sharp_neyman_bw <- function(dataset, forcing_var_name = "S", Y_name = "dropout", niter = 1000, bandwidth = c(500, 1000, 
    1500), cut_value = 15000, whichunder = 1, cin = 0.05) {
    len_bw <- length(bandwidth)
    
    s0 <- cut_value
    if (whichunder == 1) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 1, 0)
    } else if (whichunder == 0) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 0, 1)
    }
    
    Sh <- dataset[, forcing_var_name]
    pbalioak <- c()
    nak <- c()
    
    for (b in 1:len_bw) {
        
        h <- bandwidth[b]/2
        
        dat_bw <- dataset[Sh >= s0 - h & Sh <= s0 + h, ]
        
        N <- dim(dat_bw)[1]
        
        zg <- as.numeric(dat_bw[, "assigVar"])
        yg <- as.numeric(dat_bw[, Y_name])
        
        ft <- sharp_neyman(Y = yg, Z = zg, cin = cin)
        pbalioak <- c(pbalioak, ft)
        
    }
    
    dfp <- data.frame(matrix(pbalioak, ncol = 5, byrow = T))
    dfp[, 2:5] <- round(dfp[, 2:5], 4)
    
    df <- cbind(bandwidth, dfp)
    names(df) <- c("Bandwidth", "N", "Average causal effect", "Neyman SE", paste0((1 - cin) * 100, "% CI: Lower bound"), paste0((1 - cin) * 100, 
        "% CI: upper bound"))
    return(df)
    
}





#' @title Fuzzy - neyman approach
#' @description fuzzy_neyman() calculates the causal effect with the fuzzy neyman approach
#' @param Y A numerical vector with outcome information
#' @param Z A numerical vector with the forcing variable in binary format
#' @param Wh A vector that defines the treatment receipt status.
#' @param cin Alpha level for the confidence intervals (e.g. the default 0.05 yields 95\% confidence intervals)
#' @details The focus will be on the sharp nullhypothesis that disallows any effect of assignment to treatment versus control for compliersbelonging toUs0:H0:Yi(0) =Yi(1)for alli?\210\210 Us0withGi=c, which can be interpreted asthe null hypothesis of no effect of ?\200?receipt?\200\235 of treatment on outcome for the subpopulationof compliers belonging toUs.
#' @return A vector with information about the effects and confidence intervals. 
#' @export
fuzzy_neyman <- function(Y, Wh, Z, cin = 0.05) {
    m.y1 <- mean(Y[Z == 1])
    m.y0 <- mean(Y[Z == 0])
    tau.y <- m.y1 - m.y0
    tau.y
    
    m.w1 <- mean(Wh[Z == 1])
    m.w0 <- mean(Wh[Z == 0])
    tau.w <- m.w1 - m.w0
    tau.w
    
    tau.c <- tau.y/tau.w
    tau.c
    
    if (length(table(Y)) == 2) {
        Vneyman.Y <- (m.y1 * (1 - m.y1))/sum(Z == 1) + (m.y0 * (1 - m.y0))/sum(Z == 0)
        
    } else if (length(table(Y)) > 2) {
        Vneyman.Y <- (stats::var(Y[Z == 1]))/sum(Z == 1) + (stats::var(Y[Z == 0]))/sum(Z == 0)
    }
    
    if (length(table(Y)) == 2) {
        Vneyman.W <- (m.w1 * (1 - m.w1))/sum(Z == 1) + (m.w0 * (1 - m.w0))/sum(Z == 0)
        
    } else if (length(table(Y)) > 2) {
        Vneyman.W <- (stats::var(Y[Z == 1]))/sum(Z == 1) + (stats::var(Y[Z == 0]))/sum(Z == 0)
    }
    
    cov.tau.w.tau.y <- {
        sum(Y[Z == 1] == 1 & Wh[Z == 1] == 1)/sum(Z == 1) - m.w1 * m.y1
    }/sum(Z == 1)
    
    Vtau.c <- {
        1/tau.w^2
    } * Vneyman.Y + {
        tau.y^2/tau.w^4
    } * Vneyman.W - 2 * {
        tau.y/tau.w^3
    } * cov.tau.w.tau.y
    Vtau.c
    sqrt(Vtau.c)
    
    cig <- 1 - cin/2
    zz <- stats::qnorm(cig)
    tau.c - zz * sqrt(Vtau.c)
    tau.c + zz * sqrt(Vtau.c)
    
    vector <- c(tau.w, tau.y, tau.c, sqrt(Vneyman.W), sqrt(Vneyman.Y), sqrt(Vtau.c), tau.w - zz * sqrt(Vneyman.W), tau.y - 
        zz * sqrt(Vneyman.Y), tau.c - zz * sqrt(Vtau.c), tau.w + zz * sqrt(Vneyman.W), tau.y + zz * sqrt(Vneyman.Y), 
        tau.c + zz * sqrt(Vtau.c))
    return(vector)
}


#' @title Bandwidth selection for Fuzzy - neyman bandwidth
#' @description fuzzy_neyman() was defined to calculate just for one dataset. For the cases where the user wants to test several bandwidths this functions is applied. 
#' @param dataset The data frame with the variables 
#' @param forcing_var_name The name of the forcing variable in the dataset.
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth A numerical vector defining the ranges to subset the dataset and create the subpopulations of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param W The name that defines the treatment receipt status in the dataset.
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @param cin Alpha level for the confidence intervals (e.g. the default 0.05 yields 95\% confidence intervals)
#' @return A data frame with effect and bandwidths
#' @export
fuzzy_neyman_bw <- function(dataset, forcing_var_name = "S", Y_name = "dropout", niter = 1000, W = "W", bandwidth = c(500, 
    1000, 1500), cut_value = 15000, whichunder = 1, cin = 0.05) {
    
    len_bw <- length(bandwidth)
    
    s0 <- cut_value
    if (whichunder == 1) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 1, 0)
    } else if (whichunder == 0) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 0, 1)
    }
    
    Sh <- dataset[, forcing_var_name]
    pbalioak <- c()
    nak <- c()
    
    df2 <- data.frame(matrix(888, 1, 6))
    
    names(df2) <- c("Bandwidth", "Estimand", "Average causal effect", "Neyman SE", paste0((1 - cin) * 100, "% CI: Lower bound"), 
        paste0((1 - cin) * 100, "% CI: upper bound"))
    
    for (b in 1:len_bw) {
        
        h <- bandwidth[b]/2
        
        dat_bw <- dataset[Sh >= s0 - h & Sh <= s0 + h, ]
        
        N <- dim(dat_bw)[1]
        
        zg <- as.numeric(dat_bw[, "assigVar"])
        yg <- as.numeric(dat_bw[, Y_name])
        wg <- as.numeric(dat_bw[, W])
        
        ft <- fuzzy_neyman(Y = yg, Wh = wg, Z = zg, cin = cin)
        
        dfp <- data.frame(matrix(ft, ncol = 4))
        dfp[, 1:4] <- round(dfp[, 1:4], 4)
        
        df <- cbind(rep(bandwidth[b], 3), c("ITT.W", "ITT.Y", "CACE"), dfp)
        names(df) <- c("Bandwidth", "Estimand", "Average causal effect", "Neyman SE", paste0((1 - cin) * 100, "% CI: Lower bound"), 
            paste0((1 - cin) * 100, "% CI: upper bound"))
        df2 <- rbind(df2, df)
        
    }
    
    df2 <- df2[-1, ]
    return(df2)
    
}



#' @title Fuzzy - FEP approach for binary one sided
#' @details This is for the cases where the noncompliance is one sided and binary
#' @param dataset The data frame with the variables 
#' @param Y Y A numerical vector with outcome information
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param W A vector that defines the treatment receipt status.
#' @param Z A numerical vector with the forcing variable in binary format.
#' @param M2 number of iterations
#' @return A list with values of pppv, Tsim, Tobs
#' @export
fuzzy_fep1sided <- function(dataset, Y, W, Z, Y_name, M2 = 10) {
    
    Nh <- nrow(dataset)
    ITT.Y <- mean(Y[Z == 1]) - mean(Y[Z == 0])
    ITT.W <- mean(W[Z == 1]) - mean(W[Z == 0])
    CACE.IV.obs <- ITT.Y/ITT.W
    CACE.IV.obs
    
    names(dataset)[which(names(dataset) == Y_name)] <- "Y"
    CACE.MLE.obs <- EM.bin(dat = dataset)
    
    CACE.PM.obs <- mcmc.bin(n.iter = 1000, n.burn = 500, dat = dataset)
    
    Tobs <- c(CACE.IV.obs, CACE.MLE.obs, CACE.PM.obs)
    M <- as.numeric(as.character(M2))
    nit <- 2 * M
    nburn <- nit - M
    
    G <- mcmc.bin.h0(n.iter = nit, n.burn = nburn, dat = dataset)$Gstatus
    
    Y1 <- Y0 <- Y
    Tsim <- matrix(0, M, 3)
    colnames(Tsim) <- c("CACE.IV", "CACE.MLE", "CACE.PM")
    
    for (i in 1:M) {
        Zh.sim <- sample(Z, Nh, replace = TRUE)
        
        dataset.sim <- data.frame(Z = Zh.sim, W = 0 * (1 - Zh.sim) + G[i, ] * Zh.sim, Y = Y0 * (1 - Zh.sim) + Y1 * Zh.sim)
        
        ITT.Y <- mean(dataset.sim$Y[dataset.sim$Z == 1]) - mean(dataset.sim$Y[dataset.sim$Z == 0])
        ITT.W <- mean(dataset.sim$W[dataset.sim$Z == 1]) - mean(dataset.sim$W[dataset.sim$Z == 0])
        CACE.IV.sim <- ITT.Y/ITT.W
        CACE.MLE.sim <- EM.bin(dat = dataset.sim)
        CACE.PM.sim <- mcmc.bin(n.iter = 1000, n.burn = 500, dat = dataset.sim)
        
        Tsim[i, ] <- c(CACE.IV.sim, CACE.MLE.sim, CACE.PM.sim)
    }
    
    pppv <- apply(abs(Tsim) >= abs(Tobs), 2, mean)
    
    
    return(list(pppv, Tsim, Tobs))
}

#' @title Fuzzy - FEP binary two sided
#' @details This is for the cases where the noncompliance is two sided and binary
#' @param dataset The data frame with the variables 
#' @param Y Y A numerical vector with outcome information
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param W A vector that defines the treatment receipt status.
#' @param Z A numerical vector with the forcing variable in binary format.
#' @param M2 number of iterations
#' @return A list with values of pppv, Tsim, Tobs
#' @export
fuzzy_fep2sided <- function(dataset, Y, W, Z, Y_name, M2 = 10) {
    
    Nh <- nrow(dataset)
    
    ITT.Y <- mean(Y[Z == 1]) - mean(Y[Z == 0])
    ITT.W <- mean(W[Z == 1]) - mean(W[Z == 0])
    CACE.IV.obs <- ITT.Y/ITT.W
    CACE.IV.obs
    
    names(dataset)[which(names(dataset) == Y_name)] <- "Y"
    CACE.MLE.obs <- EM.bin2(dat = dataset)
    
    CACE.PM.obs <- mcmc.bin2(n.iter = 1000, n.burn = 500, dat = dataset)
    
    Tobs <- c(CACE.IV.obs, CACE.MLE.obs, CACE.PM.obs)
    M <- as.numeric(as.character(M2))
    nit <- 2 * M
    nburn <- nit - M
    
    G <- mcmc.bin.h02(n.iter = nit, n.burn = nburn, dat = dataset)$Gstatus
    
    Y1 <- Y0 <- Y
    Tsim <- matrix(0, M, 3)
    colnames(Tsim) <- c("CACE.IV", "CACE.MLE", "CACE.PM")
    
    for (i in 1:M) {
        
        Zh.sim <- sample(dataset$Z, Nh, replace = TRUE)
        
        Wh.sim <- 0 * {
            (1 - Zh.sim) * (G[i, ] == 1 | G[i, ] == 3) + Zh.sim * (G[i, ] == 1)
        } + 1 * {
            (1 - Zh.sim) * (G[i, ] == 2) + Zh.sim * (G[i, ] == 2 | G[i, ] == 3)
        }
        
        dath.sim <- data.frame(Z = Zh.sim, W = Wh.sim, Y = Y0 * (1 - Zh.sim) + Y1 * Zh.sim)
        
        
        ITT.Y <- mean(dath.sim$Y[dath.sim$Z == 1]) - mean(dath.sim$Y[dath.sim$Z == 0])
        ITT.W <- mean(dath.sim$W[dath.sim$Z == 1]) - mean(dath.sim$W[dath.sim$Z == 0])
        CACE.IV.sim <- ITT.Y/ITT.W
        CACE.MLE.sim <- EM.bin2(dat = dath.sim)
        CACE.PM.sim <- mcmc.bin2(n.iter = 1000, n.burn = 500, dat = dath.sim)
        
        Tsim[i, ] <- c(CACE.IV.sim, CACE.MLE.sim, CACE.PM.sim)
        
    }
    
    pppv <- apply(abs(Tsim) >= abs(Tobs), 2, mean)
    
    
    return(list(pppv, Tsim, Tobs))
}

#' @title Fuzzy - FEP 1 sided numerical
#' @details This is for the cases where the noncompliance is two sided and numerical
#' @param dataset The data frame with the variables 
#' @param Y Y A numerical vector with outcome information
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param W A vector that defines the treatment receipt status.
#' @param Z A numerical vector with the forcing variable in binary format.
#' @param M2 number of iterations
#' @return A list with values of pppv, Tsim, Tobs
#' @export
fuzzy_fep_numeric1sided <- function(dataset, Y, W, Z, Y_name, M2 = 10) {
    
    G <- NULL
    G[Z == 1 & W == 1] <- 1
    G[Z == 1 & W == 0] <- 0
    G[Z == 0] <- stats::rbinom(sum(Z == 0), 1, sum(Z == 1 & W == 1)/sum(Z == 1))
    Y <- NULL
    Y[Z == 0 & G == 1] <- stats::rnorm(sum(Z == 0 & G == 1), 40, 9)
    Y[Z == 1 & G == 1] <- stats::rnorm(sum(Z == 1 & G == 1), 60, 4)
    Y[G == 0] <- stats::rnorm(sum(G == 0), 50, 12)
    rm(G)
    dataset <- data.frame(Z = Z, W = W, Y = Y)
    Nh <- nrow(dataset)
    
    ITT.Y <- mean(Y[Z == 1]) - mean(Y[Z == 0])
    ITT.W <- mean(W[Z == 1]) - mean(W[Z == 0])
    CACE.IV.obs <- ITT.Y/ITT.W
    CACE.IV.obs
    
    names(dataset)[which(names(dataset) == Y_name)] <- "Y"
    CACE.MLE.obs <- EM.gauss(dat = dataset)
    
    CACE.PM.obs <- mcmc.gauss(n.iter = 1000, n.burn = 500, dat = dataset)
    
    Tobs <- c(CACE.IV.obs, CACE.MLE.obs, CACE.PM.obs)
    M <- as.numeric(as.character(M2))
    nit <- 2 * M
    nburn <- nit - M
    
    G <- mcmc.gauss.h0(n.iter = nit, n.burn = nburn, dat = dataset)$Gstatus
    
    Y1 <- Y0 <- Y
    Tsim <- matrix(0, M, 3)
    colnames(Tsim) <- c("CACE.IV", "CACE.MLE", "CACE.PM")
    
    for (i in 1:M) {
        
        Zh.sim <- sample(Z, Nh, replace = TRUE)
        
        dataset.sim <- data.frame(Z = Zh.sim, W = 0 * (1 - Zh.sim) + G[i, ] * Zh.sim, Y = Y0 * (1 - Zh.sim) + Y1 * Zh.sim)
        
        ITT.Y <- mean(dataset.sim$Y[dataset.sim$Z == 1]) - mean(dataset.sim$Y[dataset.sim$Z == 0])
        ITT.W <- mean(dataset.sim$W[dataset.sim$Z == 1]) - mean(dataset.sim$W[dataset.sim$Z == 0])
        CACE.IV.sim <- ITT.Y/ITT.W
        CACE.MLE.sim <- EM.gauss(dat = dataset.sim)
        CACE.PM.sim <- mcmc.gauss(n.iter = 1000, n.burn = 500, dat = dataset.sim)
        
        Tsim[i, ] <- c(CACE.IV.sim, CACE.MLE.sim, CACE.PM.sim)
    }
    
    pppv <- apply(abs(Tsim) >= abs(Tobs), 2, mean)
    
    
    return(list(pppv, Tsim, Tobs))
}

#' @title Fuzzy - FEP 2 sided numerical
#' @details This is for the cases where the noncompliance is one sided and numerical
#' @param dataset The data frame with the variables 
#' @param Y Y A numerical vector with outcome information
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param W A vector that defines the treatment receipt status.
#' @param Z A numerical vector with the forcing variable in binary format.
#' @param M2 number of iterations
#' @return A list with values of pppv, Tsim, Tobs
#' @export
fuzzy_fep_numeric2sided <- function(dataset, Y, W, Z, Y_name, M2 = 10) {
    
    G <- NULL
    G[Z == 0 & W == 1] <- 2
    G[Z == 1 & W == 0] <- 1
    
    
    pnt <- sum(Z == 1 & W == 0)/sum(Z == 1)
    pat <- sum(Z == 0 & W == 1)/sum(Z == 0)
    pc <- 1 - pnt - pat
    
    u <- stats::rbinom(sum(Z == 0 & W == 0), 1, pc/(pc + pnt))
    G[(Z == 0 & W == 0)] <- 3 * (u == 1) + 1 * (u == 0)
    u <- stats::rbinom(sum(Z == 1 & W == 1), 1, pc/(pc + pat))
    G[(Z == 1 & W == 1)] <- 3 * (u == 1) + 2 * (u == 0)
    
    Yh <- NULL
    Yh[Z == 0 & G == 3] <- stats::rnorm(sum(Z == 0 & G == 3), 40, 9)
    Yh[Z == 1 & G == 3] <- stats::rnorm(sum(Z == 1 & G == 3), 60, 4)
    Yh[G == 1] <- stats::rnorm(sum(G == 1), 50, 12)
    Yh[G == 2] <- stats::rnorm(sum(G == 2), 45, 8)
    rm(G, u, pc, pat, pnt)
    dath <- data.frame(Z = Z, W = W, Y = Yh)
    Nh <- nrow(dath)
    
    ITT.Y <- mean(Y[Z == 1]) - mean(Y[Z == 0])
    ITT.W <- mean(W[Z == 1]) - mean(W[Z == 0])
    CACE.IV.obs <- ITT.Y/ITT.W
    CACE.IV.obs
    
    names(dataset)[which(names(dataset) == Y_name)] <- "Y"
    CACE.MLE.obs <- EM.gauss2(dat = dataset)
    
    CACE.PM.obs <- mcmc.gauss2(n.iter = 1000, n.burn = 500, dat = dataset)
    
    Tobs <- c(CACE.IV.obs, CACE.MLE.obs, CACE.PM.obs)
    M <- as.numeric(as.character(M2))
    nit <- 2 * M
    nburn <- nit - M
    
    G <- mcmc.gauss.h02(n.iter = nit, n.burn = nburn, dat = dataset)$Gstatus
    
    Y1 <- Y0 <- Y
    Tsim <- matrix(0, M, 3)
    colnames(Tsim) <- c("CACE.IV", "CACE.MLE", "CACE.PM")
    
    for (i in 1:M) {
        Z.sim <- sample(dath$Z, Nh, replace = TRUE)
        
        W.sim <- 0 * {
            (1 - Z.sim) * (G[i, ] == 1 | G[i, ] == 3) + Z.sim * (G[i, ] == 1)
        } + 1 * {
            (1 - Z.sim) * (G[i, ] == 2) + Z.sim * (G[i, ] == 2 | G[i, ] == 3)
        }
        
        dath.sim <- data.frame(Z = Z.sim, W = W.sim, Y = Y0 * (1 - Z.sim) + Y1 * Z.sim)
        
        ITT.Y <- mean(dath.sim$Y[dath.sim$Z == 1]) - mean(dath.sim$Y[dath.sim$Z == 0])
        ITT.W <- mean(dath.sim$W[dath.sim$Z == 1]) - mean(dath.sim$W[dath.sim$Z == 0])
        CACE.IV.sim <- ITT.Y/ITT.W
        CACE.MLE.sim <- EM.gauss2(dat = dath.sim)
        CACE.PM.sim <- mcmc.gauss2(n.iter = 1000, n.burn = 500, dat = dath.sim)
        
        Tsim[i, ] <- c(CACE.IV.sim, CACE.MLE.sim, CACE.PM.sim)
        
    }
    
    pppv <- apply(abs(Tsim) >= abs(Tobs), 2, mean)
    
    
    return(list(pppv, Tsim, Tobs))
}



#' @title Bandwidth selection for Fuzzy - FEP bandwidth
#' @description fuzzy_fep() was defined to calculate just for one dataset. For the cases where the user wants to test several bandwidths this functions is applied. 
#' @param dataset The data frame with the variables 
#' @param forcing_var_name forcing_var_name
#' @param Y_name A character format of the name of the outcome in the dataset
#' @param niter Number of iteration to calculate the adjusted p-value.
#' @param bandwidth A numerical vector defining the ranges to subset the dataset and create the subpopulations of interest.
#' @param cut_value Threshold value to separate the treatment status. 
#' @param M2 number of iterations
#' @param W_name The name that defines the treatment receipt status.
#' @param typemod If the outcome is binary or numerical
#' @param typesided If the treatment receipt status is onesided or twosided
#' @param whichunder If the treatment status is lower (0) or higher (1) than the threshold 
#' @return data frame with variable and value and bandwidth
#' @export
fuzzy_fep_bw <- function(dataset, forcing_var_name = "S", Y_name = "dropout", niter = 1000, W_name = "W", bandwidth = c(500, 
    1000, 1500), cut_value = 15000, M2 = 5, whichunder = 1, typemod = "binary", typesided = "onesided") {
    
    dataset$W <- dataset[, W_name]
    dataset$Y <- dataset[, Y_name]
    
    len_bw <- length(bandwidth)
    
    s0 <- cut_value
    if (whichunder == 1) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 1, 0)
    } else if (whichunder == 0) {
        dataset$assigVar <- ifelse(dataset[, forcing_var_name] <= cut_value, 0, 1)
    }
    
    dataset$Z <- dataset$assigVar
    
    Sh <- dataset[, forcing_var_name]
    pbalioak <- c()
    nak <- c()
    
    df2 <- data.frame(matrix(888, 1, 4))
    names(df2) <- c("Bandwidth", "Statistic: IV estimate of CACE", "Statistic: MLE of CACE", "Statistic: Posterior median of CACE")
    dfvec <- data.frame(matrix(888, 1, 3))
    names(dfvec) <- c("CACE.IV", "CACE.MLE", "CACE.PM")
    dfp <- 0
    
    for (b in 1:len_bw) {
        
        h <- bandwidth[b]/2
        
        dat_bw <- dataset[Sh >= s0 - h & Sh <= s0 + h, ]
        
        N <- dim(dat_bw)[1]
        
        zg <- dat_bw[, "assigVar"]
        yg <- dat_bw[, Y_name]
        wg <- dat_bw[, W_name]
        
        if (typemod == "binary") {
            if (typesided == "onesided") {
                fu <- fuzzy_fep1sided(dat_bw, Y = yg, W = wg, Z = zg, Y_name = Y_name, M2 = M2)
                ft <- c(bandwidth[b], fu[[1]])
            } else if (typesided == "twosided") {
                fu <- fuzzy_fep2sided(dat_bw, Y = yg, W = wg, Z = zg, Y_name = Y_name, M2 = M2)
                ft <- c(bandwidth[b], fu[[1]])
            }
            
        } else if (typemod == "numeric") {
            if (typesided == "onesided") {
                fu <- fuzzy_fep_numeric1sided(dat_bw, Y = yg, W = wg, Z = zg, Y_name = Y_name, M2 = M2)
                ft <- c(bandwidth[b], fu[[1]])
            } else if (typesided == "twosided") {
                fu <- fuzzy_fep_numeric2sided(dat_bw, Y = yg, W = wg, Z = zg, Y_name = Y_name, M2 = M2)
                ft <- c(bandwidth[b], fu[[1]])
            }
            
        }
        
        df2 <- rbind(df2, ft)
        dfvec <- rbind(dfvec, fu[[2]])
        dfp <- rbind(dfp, fu[[3]])
        
    }
    
    df2 <- df2[-1, ]
    dfvec <- dfvec[-1, ]
    dfp <- dfp[-1, ]
    return(list(df2, dfvec, dfp))
    
}


#' Absolute difference in means between treatment groups
#'
#' @description Internal helper that computes the absolute value of the
#' difference in means of a variable between the two assignment groups. It is
#' used as test statistic in the randomization-based balance tests.
#' @param x A numeric vector (covariate values)
#' @param z A binary vector with the treatment assignment indicator
#' @return A numeric value: the absolute difference in means between the two groups.
#' @keywords internal
#' @export
Tave <- function(x, z) {
    x0 <- mean(x[z == 0])
    x1 <- mean(x[z == 1])
    return(abs(x1 - x0))
    
}



