dark-peak-analytics / heconpack Goto Github PK

#' Calculate Expected Value
#'
#' This function calculates the expected effect and cost based on probability, effect, and cost vectors.
#'
#' @param v_probs A vector of probabilities.
#' @param v_effect A vector of effects.
#' @param v_cost A vector of costs.
#'
#' @return A named vector with the expected effect and expected cost.
#' @export
#'
#' @examples
#' v_probs <- c(0.3, 0.5, 0.2)
#' v_effect <- c(0.8, 0.6, 0)
#' v_cost <- c(10, 20, 30)
#' getExpectedValue(v_probs, v_effect, v_cost)
#'
#' @import assertthat
#' @import dplyr
getExpectedValue <- function(v_probs,
                             v_effect,
                             v_cost) {
  # check the names are the same (or null) and in same order
  assertthat::assert_that(all(c(names(v_probs) == names(v_effect),
                             names(v_probs) == names(v_cost))),
                          msg = "The input vectors have different names or orders")
  # check the probabilities sum to 1
  assertthat::assert_that(assertthat::are_equal(
    x = sum(v_probs, na.rm = T),
    y = 1,
    tol = 1E-8
  ), msg = "Probabilities do not sum to 1" )
  # check the effect is between 0 and 1, if outside then warning (not error)
  if(any(!dplyr::between(x = v_effect,
                        left = 0, 
                        right = 1))){
    warning(call. = F,
            "One or more health state utilities entered are below 0 or above 1")
  }
  # return the expected effect and costs
  c(
    "expected_effect" = sum(v_probs * v_effect),
    "expected_cost" = sum(v_probs * v_cost)
  )
  
}

getExpectedValue(v_probs  = c("H" = 0.1, "S" = 0.9, "D" = 0),
                 v_effect = c(1, 0.5, 0),
                 v_cost   = c(0, 500, 1000))