model_averaging: Average predictions from multiple models

In mapbayr: MAP-Bayesian Estimation of PK Parameters

Average predictions from multiple models

Description

Model Averaging consists in analyzing the same data with different models and to average their predictions. In order to perform weighted means of clearance predictions, (or concentrations, or any metric of interest), it is necessary to compute the "weight" of each estimation. It is informed by the likelihood of estimation. Two weighting scheme are currently implemented, one based on the log- likelihood ("LL", the default), the other on the Akaike criterion ("AIC"). The method was previously described by Uster et al (2021) \Sexpr[results=rd]{tools:::Rd_expr_doi("10.1002/cpt.2065")}.

Usage

model_averaging(
  ...,
  output_function = as.data.frame,
  scheme = c("LL", "AIC"),
  estlist = NULL
)

compute_weights(..., scheme = c("LL", "AIC"), estlist = NULL)

do_model_averaging(list_of_tabs, weights_matrix)

Arguments

...	estimation objects generated with mapbayest(), from which the weights will be computed
output_function	a unique function that takes any estimation object and returns a table with controlled variables, dimensions and attributes.
scheme	scheme weight, either "LL" or "AIC"
estlist	a list of estimation objects. Overrides ...
list_of_tabs, weights_matrix	respectively outputs of the output_function and compute_weights()

Value

• model_averaging() and do_model_averaging(): a data.frame of the same dimensions and attributes as the outputs

• compute_weights(): a matrix with IDs as rows and estimation weights as columns

Examples

library(magrittr)

# Three different models: A, B, and C.
modA <- exmodel(1, add_exdata = FALSE)
modB <- mrgsolve::param(modA, TVCL = 2, TVVC = 30)
modC <- mrgsolve::param(modA, TVCL = 10)

# A common dataset that has 2 patients (ID 2 & 9)
data <- adm_rows(ID = 2, time = 0, amt = 200, addl = 3, ii = 24, cmt = 1) %>%
    obs_rows(ID = 2, time = 84, DV = 1.5, cmt = 2) %>%
    adm_rows(ID = 9, time = 0, amt = 100, addl = 3, ii = 24, cmt = 1) %>%
    obs_rows(ID = 9, time = 96, DV = 1, cmt = 2)

# Three different estimation objects: A, B and C.
estA <- mapbayest(modA, data)
as.data.frame(estA)
plot(estA) # Fit is pretty good

estB <- mapbayest(modB, data)
as.data.frame(estB)
plot(estB) # Excellent fit

estC <- mapbayest(modC, data)
as.data.frame(estC)
plot(estC) # Fit is worst

# Model averaging
model_averaging(A = estA, B = estB, C = estC)
# Weighted average of the table returned by as.data.frame(est))

# Internally, it first computes the "weight" of each model such as:
W <- compute_weights(A = estA, B = estB, C = estC)

# Then multiply the prediction table with each weight such as:
do_model_averaging(
  list_of_tabs = list(
    A = as.data.frame(estA),
    B = as.data.frame(estB),
    C = as.data.frame(estC)
    ),
  weights_matrix = W
  )

# If you do not want to perform an average of the full table, you can specify
# a function that takes the estimation object as an input and returns
# value(s) of interest: a single prediction, a clearance value, a full
# table of augmented predictions... as long as the structure of the final
# object is the same whatever the model.

reframe <- function(est){
  # From any estimation object, return a table with ID, time and predictions
  as.data.frame(est)[,c("ID", "time", "DV", "IPRED")]
}

model_averaging(A = estA, B = estB, C = estC, output_function = reframe)

# Make a plot that compares predictions
List_aug_tab <- lapply(
  X = list(A = estA, B = estB, C = estC),
  FUN = \(x) augment(x)$aug_tab
)
List_aug_tab$.AVERAGE <- do_model_averaging(List_aug_tab, W)

mapbayr_plot(
 aug_tab = dplyr::bind_rows(List_aug_tab, .id = "MODEL"),
 obs_tab = data,
 PREDICTION = "IPRED",
 MODEL_color = c(.AVERAGE = "black")
)

mapbayr documentation built on July 26, 2023, 5:16 p.m.