R/evsinew3.R

In sergioventurini/SAuR: Sensitivity Analysis Using R

#' Improved Expected Utility by Conditioning.
#'
#' Improved expected utility calculation by conditioning on each variable.
#'
#' @param X A \code{matrix} object with size (nSamples, nVars) containing the
#'   values of random variables in each run
#' @param U A \code{matrix} object with size (nSamples, nDecisions) containing
#'   the utility values given state X[s, ] and action j
#' @param h A length-one numeric vector providing the number of bins for
#'   conditioning on each X[, i]
#' @return A length-one numeric vector containing the expected value of perfect
#'   information.
#' @author Sergio Venturini \email{sergio.venturini@unito.it}
#' @seealso \code{\link{betaKS3_R}} for computing some sensitivity measures.
#' @references
#'   Venturini, S., Borgonovo, E. (2020), "Sensitivity Analysis Using 
#'   \code{R}: the \pkg{SAuR} Package", Technical report.
#' @examples
#' \dontrun{
#' data(simdata_sub, package = "SAuR")
#'
#' }
#'
#' @export
evsinew3 <- function(X, U, h) {
  nSamples <- nrow(X)
  nVars <- ncol(X)
  nDecisions <- ncol(U)
  W <- round(nSamples/h)
  EVPI <- numeric(nVars)
  mm <- matrix(0, nrow = h, ncol = (nDecisions + 1))
  eee <- numeric(h)
  for (i in 1:nVars) {
    MM <- cbind(X[, i], U)
    idx <- order(MM[, 1])
    MM <- MM[idx, ]
    for (uu in 1:h) {
      for (l in 2:(nDecisions + 1)) {
        mm[uu, l] <- mean(MM[((uu - 1)*W + 1):min(c((uu - 1)*W + W, nSamples)), l])
      }
      eee[uu] <- max(mm[uu, -1])
    }
    EVPI[i] = mean(eee) - max(colMeans(U))
  }
  
  return(EVPI)
}