tests/testthat/example_project/R/calculate_costs.R

In assertHE: Visualisation and Verification of Health Economic Decision Models

#' Calculate Costs
#'
#' @description Calculate the costs associated with certain states in a Markov
#' model.
#'
#' @param Markov_trace_ Numeric matrix representing the Markov trace of the
#' model.
#' @param costs_ Numeric vector defining the costs associated with each state in
#' a Markov model.
#' @param discounting_weights_ Numeric vector containing the discounting weights
#' associated with each cycle.
#'
#' @return A numeric vector containing the costs incurred over a Markov model
#' time horizon, for each state.
#'
#' @family costs
#'
#' @export
#'
#' @examples
#' \dontrun{
#' Markov_trace <- matrix(
#'   data = c(1, 0, 0, 0,
#'            0.845, 0.15, 0, 0.005,
#'            0.789025, 0.1837612, 0.01575, 0.01146377,
#'            0.7586067, 0.1881968, 0.03427491, 0.01892157,
#'            0.7351211, 0.1853199, 0.05235988, 0.02719916),
#'  nrow = 5,
#'  byrow = TRUE,
#'  dimnames = list(1:5,
#'                  c("H", "S1", "S2", "D"))
#' )
#' discounted_costs <- calculate_costs(
#'   Markov_trace_ = Markov_trace,
#'   costs_ = c("c_H" = 2000, "c_S1" = 4000, "c_S2" = 15000, "c_Trt" = 12000),
#'   discounting_weights_ = c(0.9661836, 0.9335107, 0.901942, 0.871442, 0.841973)
#' )
#' }
calculate_costs <- function(Markov_trace_,
                            costs_,
                            discounting_weights_) {
  ## Sanity checks - inputs:

  # confirm no missing values in values passed to each argument
  for(x in c("discounting_weights_", "Markov_trace_", "costs_")) {
    assertthat::assert_that(
      assertthat::noNA(get(x)),
      msg = paste(
        "The object passed to the",
        x,
        "argument contains one or more missing value(s)"
      )
    )
  }
  # ensure passed objects are of the correct type/class
  assertthat::assert_that(
    any(is.matrix(Markov_trace_), is.array(Markov_trace_)),
    msg = paste(
      "The object passed to the Markov_trace_ argument is not of class",
      "matrix/array"
    )
  )
  for(x in c("costs_", "discounting_weights_")) {
    assertthat::assert_that(
      assertthat::noNA(get(x)),
      msg = paste(
        "The object passed to the",
        x,
        "argument is not of class numeric"
      )
    )
  }
  # confirm all value(s) are 1 or less
  assertthat::assert_that(
    all(costs_ >= 0),
    msg = paste(
      "The object passed to the costs_ argument contains one or more negative",
      "value(s)"
    )
  )
  # ensure discount rates are more than 0 and less than or equal to 1
  assertthat::assert_that(
    all(discounting_weights_ > 0, discounting_weights_ <= 1),
    msg = paste(
      "The object passed to the discounting_weights_ argument contains one or",
      "more negative value(s) or value(s) more than 1"
    )
  )
  # ensure inputs were of appropriate dimensions
  assertthat::assert_that(
    length(costs_) == dim(Markov_trace_)[2],
    msg = paste(
      "The number of values in the vector passed to the costs_ argument is",
      "unequal to the number of states in the Markov_trace_ object"
    )
  )
  assertthat::assert_that(
    length(discounting_weights_) == dim(Markov_trace_)[1],
    msg = paste(
      "The number of values in the vector passed to the discounting_weights_",
      "argument is unequal to the number of cycles in the Markov_trace_ object"
    )
  )

  ## Calculate costs:

  costs <- Markov_trace_ %*% costs_
  discounted_costs <- costs * discounting_weights_

  return(discounted_costs)
}