Nothing
# Deprecated functions ---------------------------------------------------------
#' Individualized cost-effectiveness analysis
#'
#' These functions are deprecated, use [cea()] and [cea_pw()] instead.
#' @param x An object of simulation output characterizing the probability distribution
#' of clinical effectiveness and costs.?ic
#' @param ... Further arguments passed to or from other methods.
#' @keywords internal
#' @export
#' @rdname icea
icea <- function(x, ...) {
.Deprecated("cea")
UseMethod("cea")
}
#' @export
#' @rdname icea
icea_pw <- function(x, ...) {
.Deprecated("cea_pw")
UseMethod("cea_pw")
}
format_cri <- function(est, lower, upper, costs = TRUE, digits){
if (costs){
lower <- format_costs(lower, digits = digits)
upper <- format_costs(upper, digits = digits)
} else{
lower <- format_qalys(lower, digits = digits)
upper <- format_qalys(upper, digits = digits)
}
paste0(est, " (",lower, ", ", upper, ")")
}
#' ICER table
#'
#' Generate a table of incremental cost-effectiveness ratios given output from
#' [cea_pw()].
#'
#' @param x An object of class `cea_pw` returned by [cea_pw()].
#' @param k Willingness to pay.
#' @param cri If `TRUE`, credible intervals are computed; otherwise
#' they are not.
#' @param prob A numeric scalar in the interval `(0,1)` giving the credible interval.
#' Default is 0.95 for a 95 percent credible interval.
#' @param digits_qalys Number of digits to use to report QALYs.
#' @param digits_costs Number of digits to use to report costs.
#' @param output Should output be a `data.table` or a list of matrices for
#' each group.
#' @param rownames Row names for matrices when `output = "matrix"`.
#' @param colnames Column names for matrices when `output = "matrix"`.
#' @param drop If `TRUE`, then the result is coerced to the lowest possible dimension.
#' Relevant if `output = "matrix"` and there is one group, in which case a single
#' matrix will be returned if `drop = TRUE` and a list of length 1 will be returned
#' if `drop = FALSE`.
#' @seealso [cea_pw()]
#' @return If `output = "matrix"`, then a list of matrices (or a matrix if
#' \code{drop = TRUE}) reporting incremental cost-effectiveness ratios (ICERs)
#' by group. Specifically, each matrix contains five rows for: (i)
#' incremental quality-adjusted life-years (QALYs), (ii) incremental costs,
#' (iii) the incremental net monetary benefit (NMB), (iv) the ICER,
#' and (v) a conclusion stating whether each strategy is cost-effective relative
#' to a comparator. The number of columns is equal to the
#' number of strategies (including the comparator).
#'
#' If `output = "data.table"`, then the results are reported as a `data.table`,
#' with one row for each strategy and group combination.
#' @keywords internal
#' @export
icer_tbl <- function(x, k = 50000, cri = TRUE, prob = 0.95,
digits_qalys = 2,
digits_costs = 0, output = c("matrix", "data.table"),
rownames = NULL, colnames = NULL,
drop = TRUE){
.Deprecated("icer")
if (!inherits(x, "cea_pw")){
stop("'x' must be an object of class 'cea_pw'",
call. = FALSE)
}
if (prob > 1 | prob < 0){
stop("'prob' must be in the interval (0,1)",
call. = FALSE)
}
strategy <- attributes(x)$strategy
grp <- attributes(x)$grp
output <- match.arg(output)
tbl <- copy(x$summary)
tbl[, "icer" := get("ic_mean")/get("ie_mean")]
tbl[, "inmb_numeric" := k * get("ie_mean") - get("ic_mean")]
# Formatting
tbl[, "iqalys" := format_qalys(get("ie_mean"), digits = digits_qalys)]
tbl[, "icosts" := format_costs(get("ic_mean"), digits = digits_costs)]
tbl[, "icer" := format_costs(get("icer"), digits = digits_costs)]
tbl[, "icer" := ifelse(get("ic_mean") < 0 & get("ie_mean") >= 0, "Dominates", get("icer"))]
tbl[, "icer" := ifelse(get("ic_mean") > 0 & get("ie_mean") <= 0, "Dominated", get("icer"))]
tbl[, "inmb" := format_costs(get("inmb_numeric"), digits = digits_costs)]
if(cri){
prob_lower <- (1 - prob)/2
prob_upper <- 1 - prob_lower
x$delta[, "inmb" := k * get("ie") - get("ic")]
if (prob == 0.95){
tbl[, "iqalys" := format_cri(get("iqalys"), get("ie_lower"), get("ie_upper"),
costs = FALSE,
digits = digits_qalys)]
tbl[, "icosts" := format_cri(get("icosts"), get("ic_lower"), get("ic_upper"),
costs = TRUE,
digits = digits_costs)]
inmb_dt <- x$delta[, list(mean = mean(get("inmb")),
lower = stats::quantile(get("inmb"), prob_lower),
upper = stats::quantile(get("inmb"), prob_upper)),
by = c(strategy, grp)]
tbl[, "inmb" := format_cri(get("inmb"), inmb_dt$lower, inmb_dt$upper,
costs = TRUE,
digits = digits_costs)]
} else {
cri_dt <- x$delta[, list(iqalys_lower = stats::quantile(get("ie"), prob_lower),
iqalys_upper = stats::quantile(get("ie"), prob_upper),
icosts_lower = stats::quantile(get("ic"), prob_lower),
icosts_upper = stats::quantile(get("ic"), prob_upper),
inmb_lower = stats::quantile(get("inmb"), prob_lower),
inmb_upper = stats::quantile(get("inmb"), prob_upper)),
by = c(strategy, grp)]
tbl[, "iqalys" := format_cri(get("iqalys"), cri_dt$iqalys_lower,
cri_dt$iqalys_upper, costs = FALSE,
digits = digits_qalys)]
tbl[, "icosts" := format_cri(get("icosts"), cri_dt$icosts_lower,
cri_dt$icosts_upper, costs = TRUE,
digits = digits_costs)]
tbl[, "inmb" := format_cri(get("inmb"), cri_dt$inmb_lower,
cri_dt$inmb_upper, costs = TRUE,
digits = digits_costs)]
}
x$delta[, "inmb" := NULL]
} # end credible interval calculations
tbl[, "conclusion" := ifelse(get("inmb_numeric") >= 0,
"Cost-effective", "Not cost-effective")]
tbl <- tbl[, c(strategy, grp, "iqalys", "icosts", "inmb", "icer", "conclusion"),
with = FALSE]
if (output == "matrix"){
tbl_list <- split(tbl, by = grp)
mat_list <- vector(mode = "list", length = length(tbl_list))
names(mat_list) <- names(tbl_list)
n_strategies <- length(unique(tbl[[strategy]]))
mat <- matrix(NA, nrow = 5, ncol = n_strategies + 1)
if(is.null(rownames)){
rownames(mat) <- c("Incremental QALYs", "Incremental costs",
"Incremental NMB", "ICER", "Conclusion")
} else{
rownames(mat) <- rownames
}
comp_pos <- attributes(x)$comparator_pos
if (is.null(colnames)){
strategy_names <- rep(NA, ncol(mat))
strategy_names[comp_pos] <- attributes(x)$comparator
strategy_names[-comp_pos] <- as.character(tbl_list[[1]][[strategy]])
colnames(mat) <- strategy_names
} else{
colnames(mat) <- colnames
}
for (i in 1:length(mat_list)){
mat[1, -comp_pos] <- tbl_list[[i]]$iqalys
mat[2, -comp_pos] <- tbl_list[[i]]$icosts
mat[3, -comp_pos] <- tbl_list[[i]]$inmb
mat[4, -comp_pos] <- tbl_list[[i]]$icer
mat[5, -comp_pos] <- tbl_list[[i]]$conclusion
mat[, comp_pos] <- "-"
mat_list[[i]] <- mat
}
if (drop){
if(length(mat_list) == 1){
mat_list <- mat_list[[1]]
}
}
return(mat_list)
} else{
return(tbl)
}
}
# Deprecated arguments ---------------------------------------------------------
deprecate_point_estimate <- function(old, new, is_new_missing) {
if (!is.null(old)) {
warning("'point_estimate' is deprecated; use 'uncertainty' instead.",
call. = FALSE)
}
if (!is.null(old) && (old == TRUE & is_new_missing == TRUE)) {
return("none")
} else{
return(new)
}
}
deprecate_bootstrap <- function(old, new, is_new_missing) {
if (!is.null(old)) {
warning("'bootstrap' is deprecated; use 'uncertainty' instead.",
call. = FALSE)
}
if (!is.null(old) && (old == TRUE & is_new_missing == TRUE)) {
return("bootstrap")
} else{
return(new)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.