From 986fa182bea040813a4a9ee44e8e5f87527328b8 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Thu, 15 May 2025 10:21:01 +0100 Subject: [PATCH 01/17] created new ald data format and mostly fixed maic method * to finish with other methods --- R/calculate_ate.R | 44 ++++++++-------- R/maic.R | 17 +++--- R/outstandR.R | 5 +- R/prep_data.R | 34 ++---------- vignettes/Binary_data_example.Rmd | 86 +++++++++++++++++++------------ 5 files changed, 92 insertions(+), 94 deletions(-) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index c21482a..371158d 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -248,31 +248,33 @@ continuity_correction <- function(ald, treatments = list("B", "C"), correction = 0.5) { # check if correction is needed in any group - needs_correction <- any(sapply(treatments, function(t) { - y <- ald[[paste0("y.", t, ".sum")]] - N <- ald[[paste0("N.", t)]] - y == 0 || y == N - })) + needs_correction <- + ald |> + dplyr::filter((variable == "y" & statistic == "sum") | statistic == "N") |> + dplyr::group_by(trt, variable) |> + spread(statistic, value) |> # Spread sd and N into separate columns + dplyr::mutate(need_contcorr = case_when( + sum == 0 ~ TRUE, + sum == N ~ TRUE, + TRUE ~ FALSE + )) |> pull() |> any() if (!needs_correction) { return(ald) } - # apply correction to all groups - for (t in treatments) { - y_name <- paste0("y.", t, ".sum") - N_name <- paste0("N.", t) - y <- ald[[y_name]] - N <- ald[[N_name]] - - message(sprintf( - "Applying continuity correction to group %s: y = %d to %.1f, N = %d to %.1f", - t, y, y + correction, N, N + 2 * correction - )) - - ald[[y_name]] <- y + correction - ald[[N_name]] <- N + 2 * correction - } + message(sprintf( + "Applying continuity correction: %d", correction + )) + + ald_corrected <- ald %>% + dplyr::mutate( + value = case_when( + statistic == "sum" & variable == "y" ~ value + correction, + statistic == "N" ~ value + 2 * correction, + TRUE ~ value + ) + ) - ald + ald_corrected } diff --git a/R/maic.R b/R/maic.R index 22bcf05..262fe84 100644 --- a/R/maic.R +++ b/R/maic.R @@ -72,17 +72,18 @@ maic.boot <- function(ipd, indices = 1:nrow(ipd), X_EM <- dat[, effect_modifier_names] - ##TODO: why is this centering used in maic.boot() and not maic()? - - # BC effect modifier means, assumed fixed - mean_names <- get_mean_names(ald, effect_modifier_names) - # centre AC effect modifiers on BC means - dat_ALD_means <- ald[rep_len(1, n_ipd), mean_names, drop = FALSE] - X_EM <- X_EM - dat_ALD_means + dat_ALD_means <- ald |> + dplyr::filter(variable %in% effect_modifier_names, + statistic == "mean") |> + tidyr::pivot_wider(names_from = variable) |> + dplyr::select(all_of(effect_modifier_names)) |> + tidyr::uncount(weights = n_ipd) + + centred_EM <- X_EM - dat_ALD_means if (is.null(hat_w)) { - hat_w <- maic_weights(X_EM) + hat_w <- maic_weights(centred_EM) } formula_treat <- glue::glue("{formula[[2]]} ~ {trt_var}") diff --git a/R/outstandR.R b/R/outstandR.R index fa4571d..5cdaa5b 100644 --- a/R/outstandR.R +++ b/R/outstandR.R @@ -68,9 +68,8 @@ outstandR <- function(ipd_trial, ald_trial, strategy, ald <- prep_ald(strategy$formula, ald_trial, trt_var = strategy$trt_var) # treatment names for each study - - ipd_comp <- get_ipd_comparator(ipd, ref_trt, strategy$trt_var) - ald_comp <- get_ald_comparator(ald, ref_trt) + ipd_comp <- get_comparator(ipd, ref_trt, strategy$trt_var) + ald_comp <- get_comparator(ald, ref_trt, strategy$trt_var) ipd_trts <- list(ipd_comp, ref_trt) ald_trts <- list(ald_comp, ref_trt) diff --git a/R/prep_data.R b/R/prep_data.R index e373803..95aadf6 100644 --- a/R/prep_data.R +++ b/R/prep_data.R @@ -21,20 +21,9 @@ prep_ald <- function(form, data, trt_var = "trt") { term.labels <- unlist(strsplit(term.labels, ":", fixed = TRUE)) term.labels <- setdiff(term.labels, trt_var) - mean_names <- paste0("mean.", term.labels) - sd_names <- paste0("sd.", term.labels) ##TODO: for maic do we need these? - term_names <- c(mean_names, sd_names) - - # replace outcome variable name - response_var <- all.vars(form)[1] - response_names <- gsub(pattern = "y", replacement = response_var, - x = c("y.B.sum", "y.B.bar", "y.B.sd", "N.B", - "y.C.sum", "y.C.bar", "y.C.sd", "N.C")) - - keep_names <- c(term_names, response_names) - data_names <- names(data) - - data[data_names %in% keep_names] + dplyr::filter( + data, + variable %in% c("y", term.labels)) } #' Convert from long to wide format @@ -109,23 +98,10 @@ reshape_ald_to_long <- function(df) { # Get study comparator treatment names - # -get_ald_comparator <- function(ald, ref_trt = "C") { - - pattern <- paste0("^y\\.(?!", ref_trt, ")") +get_comparator <- function(dat, ref_trt = "C", trt_var = "trt") { - # filter for names starting with "y." but not with "y.C" - y_non_ref <- grep(pattern, colnames(ald), - value = TRUE, perl = TRUE) - - # extract treatment of first match - sub("^y\\.([A-Z]).*", "\\1", y_non_ref[1]) -} - -# -get_ipd_comparator <- function(ipd, ref_trt = "C", trt_var = "trt") { - all_trt <- levels(ipd[[trt_var]]) + all_trt <- levels(as.factor(dat[[trt_var]])) all_trt[all_trt != ref_trt] } diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index db0112e..ac5d28d 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -159,7 +159,7 @@ ipd_trial$trt <- factor(ipd_trial$trt, labels = c("C", "A")) ``` Similarly, to obtain the aggregate data we will simulate IPD but with the additional summarise step. -We set different mean values `meanX_BC` and `meanX_EM_BC` but otherwise use the same parameter values as for the $AC$ case. +We set different mean values `meanX_BC` and `meanX_EM_BC` but otherwise use the same parameter values as for the $AC$ trial. ```{r generate-ald-data} BC.IPD <- gen_data(N, b_trt, b_X, b_EM, b_0, @@ -168,44 +168,65 @@ BC.IPD <- gen_data(N, b_trt, b_X, b_EM, b_0, corX, allocation, family = binomial("logit")) -cov.X <- BC.IPD %>% - summarise(across(starts_with("X"), - list(mean = mean, sd = sd), - .names = "{fn}.{col}")) +BC.IPD$trt <- factor(BC.IPD$trt, labels = c("C", "B")) -out.B <- dplyr::filter(BC.IPD, trt == 1) %>% - summarise(y.B.sum = sum(y), - y.B.bar = mean(y), - y.B.sd = sd(y), - N.B = n()) - -out.C <- dplyr::filter(BC.IPD, trt == 0) %>% - summarise(y.C.sum = sum(y), - y.C.bar = mean(y), - y.C.sd = sd(y), - N.C = n()) - -ald_trial <- cbind.data.frame(cov.X, out.C, out.B) +# covariate summary statistics +# assume same between treatments +cov.X <- + BC.IPD %>% + as.data.frame() |> + dplyr::select(X1, X2, X3, X4, trt) %>% + pivot_longer(cols = starts_with("X"), names_to = "variable", values_to = "value") %>% + group_by(variable) %>% + summarise( + mean = mean(value), + sd = sd(value), + ) %>% + pivot_longer(cols = c("mean", "sd"), names_to = "statistic", values_to = "value") %>% + ungroup() |> + mutate(trt = NA) + +# outcome +summary.y <- + BC.IPD |> + as.data.frame() |> + dplyr::select(y, trt) %>% + pivot_longer(cols = "y", names_to = "variable", values_to = "value") %>% + group_by(variable, trt) %>% + summarise( + mean = mean(value), + sd = sd(value), + sum = sum(value), + ) %>% + pivot_longer(cols = c("mean", "sd", "sum"), names_to = "statistic", values_to = "value") %>% + ungroup() + +# sample sizes +summary.N <- + BC.IPD |> + group_by(trt) |> + count(name = "N") |> + pivot_longer(cols = "N", names_to = "statistic", values_to = "value") |> + mutate(variable = NA_character_) |> + dplyr::select(variable, statistic, value, trt) + +ald_trial <- rbind.data.frame(cov.X, summary.y, summary.N) ``` -This general format of data sets consist of the following. +This general format of the data sets are in a 'long' style consisting of the following. #### `ipd_trial`: Individual patient data -- `X*`: patient measurements -- `trt`: treatment ID (integer) -- `y`: (logical) indicator of whether event was observed +- `X*`: Patient measurements +- `trt`: Treatment ID (integer) +- `y`: Indicator of whether event was observed (two level factor) #### `ald_trial`: Aggregate-level data -- `mean.X*`: mean patient measurement -- `sd.X*`: standard deviation of patient measurement -- `y.*.sum`: total number of events -- `y.*.bar`: proportion of events -- `N.*`: total number of individuals - -Note that the wildcard `*` here is usually an integer from 1 or the -trial identifier *B*, *C*. +- `variable`: Covariate name. In the case of treatment arm sample size this is `NA` +- `statistic`: Summary statistic name from mean, standard deviation or sum +- `value`: Numerical value of summary statistic +- `trt`: Treatment label. Because we assume a common covariate distribution between treatment arms this is `NA` Our data look like the following. @@ -214,14 +235,13 @@ head(ipd_trial) ``` There are 4 correlated continuous covariates generated per subject, simulated from a multivariate normal distribution. -Treatment `trt` 1 corresponds to new treatment *A*, and 0 is standard of care or status quo *C*. The ITC is 'anchored' via *C*, the common treatment. +Treatment `trt` takes either new treatment *A* or standard of care or status quo *C*. The ITC is 'anchored' via *C*, the common treatment. ```{r} ald_trial ``` -In this case, we have 4 covariate mean and standard deviation values; -and the event total, average and sample size for each treatment *B*, and *C*. +In this case, we have 4 covariate mean and standard deviation values; and the event total, average and sample size for each treatment *B*, and *C*. #### Regression model From 5190bfddb8a281340558a4295541e6841eaae270 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 19:59:49 +0100 Subject: [PATCH 02/17] fixed marginal effect look up code for new ald dataframe --- R/calculate_ate.R | 63 ++++++++++++++++++++++++++----- R/prep_data.R | 2 +- vignettes/Binary_data_example.Rmd | 3 +- 3 files changed, 56 insertions(+), 12 deletions(-) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index 371158d..5c19735 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -73,8 +73,16 @@ calculate_trial_variance <- function(ald, tid, effect, family) { #' @export calculate_trial_variance_binary <- function(ald, tid, effect) { - y <- ald[[paste0("y.", tid, ".sum")]] - N <- ald[[paste0("N.", tid)]] + y <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sum")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value effect_functions <- list( "log_odds" = function() 1/y + 1/(N-y), @@ -95,9 +103,22 @@ calculate_trial_variance_binary <- function(ald, tid, effect) { #' @export calculate_trial_variance_continuous <- function(ald, tid, effect) { - ybar <- ald[[paste0("y.", tid, ".bar")]] - ysd <- ald[[paste0("y.", tid, ".sd")]] - N <- ald[[paste0("N.", tid)]] + ybar <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "mean")$value + + ysd <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sd")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value effect_functions <- list( "log_odds" = function() pi^2/3 * (1/N), @@ -133,8 +154,17 @@ calculate_trial_mean <- function(ald, tid, effect, family) { #' @export calculate_trial_mean_binary <- function(ald, tid, effect) { - y <- ald[[paste0("y.", tid, ".sum")]] - N <- ald[[paste0("N.", tid)]] + y <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sum")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value + p <- y/N effect_fns <- list( @@ -156,9 +186,22 @@ calculate_trial_mean_binary <- function(ald, tid, effect) { #' @export calculate_trial_mean_continuous <- function(ald, tid, effect) { - ybar <- ald[[paste0("y.", tid, ".bar")]] - ysd <- ald[[paste0("y.", tid, ".sd")]] - N <- ald[[paste0("N.", tid)]] + ybar <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "mean")$value + + ysd <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sd")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value effect_fns <- list( log_odds = function() { diff --git a/R/prep_data.R b/R/prep_data.R index 95aadf6..579f554 100644 --- a/R/prep_data.R +++ b/R/prep_data.R @@ -23,7 +23,7 @@ prep_ald <- function(form, data, trt_var = "trt") { dplyr::filter( data, - variable %in% c("y", term.labels)) + variable %in% c("y", term.labels) | statistic == "N") } #' Convert from long to wide format diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index ac5d28d..799e50a 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -198,7 +198,8 @@ summary.y <- sd = sd(value), sum = sum(value), ) %>% - pivot_longer(cols = c("mean", "sd", "sum"), names_to = "statistic", values_to = "value") %>% + pivot_longer(cols = c("mean", "sd", "sum"), + names_to = "statistic", values_to = "value") %>% ungroup() # sample sizes From ab88f9a7cd98953008bc46e106bbc94805bb4bd3 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 21:23:56 +0100 Subject: [PATCH 03/17] Update calc_ALD_stats.R --- R/calc_ALD_stats.R | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/R/calc_ALD_stats.R b/R/calc_ALD_stats.R index fd1e203..f46c30b 100644 --- a/R/calc_ALD_stats.R +++ b/R/calc_ALD_stats.R @@ -18,9 +18,11 @@ #' @examples #' \dontrun{ #' strategy <- list(family = list(family = "binomial")) # basic version -#' ald <- data.frame(trial = 1:5, -#' n_B = c(10, 20, 15, 30, 25), -#' n_C = c(12, 18, 20, 25, 22)) +#' ald <- data.frame(trt = c("B","C","B","C"), +#' variable = c(NA, NA, "y", "y"), +#' statistic = c("N", "N", "sum", "sum"), +#' value = c(100, 100, 50, 60) +#' #' calc_ALD_stats(strategy, ald, treatments = list("B", "C"), scale = "log") #' } #' @@ -54,7 +56,10 @@ calc_ALD_stats <- function(strategy, #' @return The total variance of marginal treatment effects. #' @examples #' \dontrun{ -#' ald <- data.frame(trial = 1:5, n_B = c(10, 20, 15, 30, 25), n_C = c(12, 18, 20, 25, 22)) +#' ald <- data.frame(trt = c("B","C","B","C"), +#' variable = c(NA, NA, "y", "y"), +#' statistic = c("N", "N", "sum", "sum"), +#' value = c(100, 100, 50, 60) #' marginal_variance(ald, treatments = list("B", "C"), scale = "log", family = "binomial") #' } #' @export @@ -88,7 +93,10 @@ marginal_variance <- function(ald, #' @return The relative treatment effect. #' @examples #' \dontrun{ -#' ald <- data.frame(trial = 1:5, n_B = c(10, 20, 15, 30, 25), n_C = c(12, 18, 20, 25, 22)) +#' ald <- data.frame(trt = c("B","C","B","C"), +#' variable = c(NA, NA, "y", "y"), +#' statistic = c("N", "N", "sum", "sum"), +#' value = c(100, 100, 50, 60) #' marginal_treatment_effect(ald, treatments = list("B", "C"), scale = "log", family = "binomial") #' } #' @export From 94db16ade6506ba6b1d341c1f579522a47ecb002 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 21:27:28 +0100 Subject: [PATCH 04/17] Update calculate_ate.R --- R/calculate_ate.R | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index 5c19735..9f85e35 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -17,23 +17,23 @@ #' @return The computed average treatment effect on the specified scale. #' @examples #' \dontrun{ -#' calculate_ate(mean_A = 0.7, mean_C = 0.5, effect = "log_odds") -#' calculate_ate(mean_A = 0.7, mean_C = 0.5, effect = "risk_difference") +#' calculate_ate(mean_A = 0.7, mean_ref = 0.5, effect = "log_odds") +#' calculate_ate(mean_A = 0.7, mean_ref = 0.5, effect = "risk_difference") #' } #' @export #' -calculate_ate <- function(mean_A, mean_C, effect) { +calculate_ate <- function(mean_A, mean_ref, effect) { if (effect == "log_odds") { - ate <- qlogis(mean_A) - qlogis(mean_C) + ate <- qlogis(mean_A) - qlogis(mean_ref) } else if (effect == "risk_difference") { - ate <- mean_A - mean_C + ate <- mean_A - mean_ref } else if (effect == "delta_z") { - ate <- qnorm(mean_A) - qnorm(mean_C) + ate <- qnorm(mean_A) - qnorm(mean_ref) } else if (effect == "log_relative_risk_rare_events") { - ate <- log(-log(1 - mean_A)) - log(-log(1 - mean_C)) + ate <- log(-log(1 - mean_A)) - log(-log(1 - mean_ref)) } else if (effect == "log_relative_risk") { # Poisson log link - ate <- log(mean_A) - log(mean_C) + ate <- log(mean_A) - log(mean_ref) } else { stop("Unsupported link function.") } @@ -53,7 +53,10 @@ calculate_ate <- function(mean_A, mean_C, effect) { #' @return The computed variance of treatment effects. #' @examples #' \dontrun{ -#' ald <- data.frame(y.B.sum = c(10), N.B = c(100)) +#' ald <- data.frame(trt = c("B","C","B","C"), +#' variable = c(NA, NA, "y", "y"), +#' statistic = c("N", "N", "sum", "sum"), +#' value = c(100, 100, 50, 60) #' calculate_trial_variance(ald, tid = "B", effect = "log_odds", family = "binomial") #' } #' @export @@ -266,24 +269,24 @@ get_treatment_effect <- function(link) { # individual effects -calc_log_odds_ratio <- function(mean_A, mean_C) { - qlogis(mean_A) - qlogis(mean_C) +calc_log_odds_ratio <- function(mean_A, mean_ref) { + qlogis(mean_A) - qlogis(mean_ref) } -calc_risk_difference <- function(mean_A, mean_C) { - mean_A - mean_C +calc_risk_difference <- function(mean_A, mean_ref) { + mean_A - mean_ref } -calc_delta_z <- function(mean_A, mean_C) { - qnorm(mean_A) - qnorm(mean_C) +calc_delta_z <- function(mean_A, mean_ref) { + qnorm(mean_A) - qnorm(mean_ref) } -calc_log_relative_risk_rare_events <- function(mean_A, mean_C) { - log(-log(1 - mean_A)) - log(-log(1 - mean_C)) +calc_log_relative_risk_rare_events <- function(mean_A, mean_ref) { + log(-log(1 - mean_A)) - log(-log(1 - mean_ref)) } -calc_log_relative_risk <- function(mean_A, mean_C) { - log(mean_A) - log(mean_C) +calc_log_relative_risk <- function(mean_A, mean_ref) { + log(mean_A) - log(mean_ref) } #' @keywords internal From 99aa155255d0f94f20c637b3ad5df090d00e2b14 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 21:29:42 +0100 Subject: [PATCH 05/17] Update calculate_ate.R --- R/calculate_ate.R | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index 9f85e35..a82e0f8 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -4,7 +4,7 @@ #' #' Computes the average treatment effect (ATE) based on the specified effect scale. #' -#' @param mean_A,mean_C Mean of the outcome for the treatment and control +#' @param mean_comp,mean_ref Mean of the outcome for the comparator and reference / common #' @param effect A character string specifying the effect scale. Options are: #' \describe{ #' \item{"log_odds"}{Log-odds difference.} @@ -17,23 +17,23 @@ #' @return The computed average treatment effect on the specified scale. #' @examples #' \dontrun{ -#' calculate_ate(mean_A = 0.7, mean_ref = 0.5, effect = "log_odds") -#' calculate_ate(mean_A = 0.7, mean_ref = 0.5, effect = "risk_difference") +#' calculate_ate(mean_comp = 0.7, mean_ref = 0.5, effect = "log_odds") +#' calculate_ate(mean_comp = 0.7, mean_ref = 0.5, effect = "risk_difference") #' } #' @export #' -calculate_ate <- function(mean_A, mean_ref, effect) { +calculate_ate <- function(mean_comp, mean_ref, effect) { if (effect == "log_odds") { - ate <- qlogis(mean_A) - qlogis(mean_ref) + ate <- qlogis(mean_comp) - qlogis(mean_ref) } else if (effect == "risk_difference") { - ate <- mean_A - mean_ref + ate <- mean_comp - mean_ref } else if (effect == "delta_z") { - ate <- qnorm(mean_A) - qnorm(mean_ref) + ate <- qnorm(mean_comp) - qnorm(mean_ref) } else if (effect == "log_relative_risk_rare_events") { - ate <- log(-log(1 - mean_A)) - log(-log(1 - mean_ref)) + ate <- log(-log(1 - mean_comp)) - log(-log(1 - mean_ref)) } else if (effect == "log_relative_risk") { # Poisson log link - ate <- log(mean_A) - log(mean_ref) + ate <- log(mean_comp) - log(mean_ref) } else { stop("Unsupported link function.") } @@ -269,24 +269,24 @@ get_treatment_effect <- function(link) { # individual effects -calc_log_odds_ratio <- function(mean_A, mean_ref) { - qlogis(mean_A) - qlogis(mean_ref) +calc_log_odds_ratio <- function(mean_comp, mean_ref) { + qlogis(mean_comp) - qlogis(mean_ref) } -calc_risk_difference <- function(mean_A, mean_ref) { - mean_A - mean_ref +calc_risk_difference <- function(mean_comp, mean_ref) { + mean_comp - mean_ref } -calc_delta_z <- function(mean_A, mean_ref) { - qnorm(mean_A) - qnorm(mean_ref) +calc_delta_z <- function(mean_comp, mean_ref) { + qnorm(mean_comp) - qnorm(mean_ref) } -calc_log_relative_risk_rare_events <- function(mean_A, mean_ref) { - log(-log(1 - mean_A)) - log(-log(1 - mean_ref)) +calc_log_relative_risk_rare_events <- function(mean_comp, mean_ref) { + log(-log(1 - mean_comp)) - log(-log(1 - mean_ref)) } -calc_log_relative_risk <- function(mean_A, mean_ref) { - log(mean_A) - log(mean_ref) +calc_log_relative_risk <- function(mean_comp, mean_ref) { + log(mean_comp) - log(mean_ref) } #' @keywords internal From f090cc182df95c6f46cd63c701dcab8445bd5407 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 21:40:33 +0100 Subject: [PATCH 06/17] Update gcomp_stan.R --- R/gcomp_stan.R | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/R/gcomp_stan.R b/R/gcomp_stan.R index 0bc340b..82212f1 100644 --- a/R/gcomp_stan.R +++ b/R/gcomp_stan.R @@ -16,8 +16,8 @@ #' #' @return A list of \eqn{y^*_A} and \eqn{y^*_C} posterior predictions: #' \describe{ -#' \item{\code{`0`}}{Posterior means for treatment group C.} -#' \item{\code{`1`}}{Posterior means for treatment group A.} +#' \item{\code{`0`}}{Posterior means for reference treatment group "C".} +#' \item{\code{`1`}}{Posterior means for comparator treatment group "A".} #' } #' @importFrom copula normalCopula mvdc rMvdc #' @importFrom rstanarm stan_glm posterior_predict @@ -30,7 +30,9 @@ #' warmup = 500, #' chains = 4 #' ) -#' ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +#' ipd <- data.frame(treatment = c(0, 1), +#' outcome = c(1, 0), +#' age = c(30, 40)) #' ald <- data.frame() #' calc_gcomp_stan(strategy, ipd, ald) #' } @@ -58,16 +60,16 @@ calc_gcomp_stan <- function(strategy, ...) # counterfactual datasets - data.comp <- data.ref <- x_star + data_comp <- data_ref <- x_star # intervene on treatment while keeping set covariates fixed - data.comp[[trt_var]] <- comp_trt # all receive treatment A - data.ref[[trt_var]] <- ref_trt # all receive treatment C + data_comp[[trt_var]] <- comp_trt # all receive comparator treatment + data_ref[[trt_var]] <- ref_trt # all receive reference treatment ##TODO: is this going to work for all of the different data types? # draw responses from posterior predictive distribution - y.star.comp <- rstanarm::posterior_predict(outcome.model, newdata = data.comp) - y.star.ref <- rstanarm::posterior_predict(outcome.model, newdata = data.ref) + y.star.comp <- rstanarm::posterior_predict(outcome.model, newdata = data_comp) + y.star.ref <- rstanarm::posterior_predict(outcome.model, newdata = data_ref) # posterior means for each treatment group list( @@ -92,8 +94,8 @@ calc_gcomp_stan <- function(strategy, #' #' @return A list containing: #' \describe{ -#' \item{mean_A}{Bootstrap estimates for treatment group A.} -#' \item{mean_C}{Bootstrap estimates for treatment group C.} +#' \item{mean_A}{Bootstrap estimates for comparator treatment group "A".} +#' \item{mean_C}{Bootstrap estimates for reference treatment group "C".} #' } #' @importFrom boot boot #' @examples @@ -105,7 +107,9 @@ calc_gcomp_stan <- function(strategy, #' trt_var = "treatment", #' N = 1000 #' ) -#' ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +#' ipd <- data.frame(treatment = c(0, 1), +#' outcome = c(1, 0), +#' age = c(30, 40)) #' ald <- data.frame() #' calc_gcomp_ml(strategy, ipd, ald) #' } From 9b20d6a28be0a34d9c58c1ee8334dcd800c356b7 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sat, 17 May 2025 21:44:42 +0100 Subject: [PATCH 07/17] Update calc_stc.R --- R/calc_stc.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/calc_stc.R b/R/calc_stc.R index b08f809..b928780 100644 --- a/R/calc_stc.R +++ b/R/calc_stc.R @@ -1,5 +1,10 @@ #' Calculate simulated treatment comparison statistics +#' @return A list: +#' \describe{ +#' \item{`mean_A`}{Mean for comparator treatment group "A".} +#' \item{`mean_C`}{Mean for reference treatment group "C".} +#' } #' @importFrom stats glm #' @export #' From 1ac5db1889bd0b17d03e7cc98b6bf178a3d2eb04 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 11:45:17 +0100 Subject: [PATCH 08/17] fixed gcomp_ml error with new ald dataframe --- R/gcomp_ml.R | 24 +++++++------- R/parse_formula.R | 54 ------------------------------- man/calc_ALD_stats.Rd | 8 +++-- man/calc_gcomp_ml.Rd | 8 +++-- man/calc_gcomp_stan.Rd | 8 +++-- man/calc_stc.Rd | 7 ++++ man/calculate_ate.Rd | 8 ++--- man/calculate_trial_variance.Rd | 5 ++- man/get_mean_names.Rd | 22 ------------- man/get_sd_names.Rd | 22 ------------- man/marginal_treatment_effect.Rd | 5 ++- man/marginal_variance.Rd | 5 ++- man/reshape_ald_to_long.Rd | 11 +++++++ vignettes/Binary_data_example.Rmd | 9 ++++-- 14 files changed, 69 insertions(+), 127 deletions(-) delete mode 100644 man/get_mean_names.Rd delete mode 100644 man/get_sd_names.Rd create mode 100644 man/reshape_ald_to_long.Rd diff --git a/R/gcomp_ml.R b/R/gcomp_ml.R index 7cb9101..15af05f 100644 --- a/R/gcomp_ml.R +++ b/R/gcomp_ml.R @@ -126,21 +126,23 @@ simulate_ALD_pseudo_pop <- function(formula, # remove treatment covariate_names <- covariate_names[covariate_names != trt_var] + n_covariates <- length(covariate_names) - mean_names <- get_mean_names(ald, covariate_names) - - sd_names <- get_sd_names(ald, covariate_names) + ald_means <- dplyr::filter(ald, statistic == "mean", variable != "y") + ald_sd <- dplyr::filter(ald, statistic == "sd", variable != "y") - n_covariates <- length(covariate_names) + # same order as covariate names + sd_values <- ald_sd$value[match(covariate_names, ald_sd$variable)] + mean_values <- ald_means$value[match(covariate_names, ald_means$variable)] - # covariate simulation for BC trial using copula package + # covariate simulation for BC ALD trial using copula package # don't require copula for single covariate if (length(covariate_names) <= 1) { x_star <- rnorm(n = N, - mean = ald[[mean_names]], - sd = ald[[sd_names]]) |> + mean = mean_values, + sd = sd_values) |> matrix(ncol = 1, dimnames = list(NULL, covariate_names)) return(x_star) @@ -164,11 +166,11 @@ simulate_ALD_pseudo_pop <- function(formula, dispstr = "un") # aggregate BC covariate means & standard deviations - mean_sd_margins <- list() + mean_sd_margins <- vector(mode = "list", length = n_covariates) - for (i in covariate_names) { - mean_sd_margins[[i]] <- list(mean = ald[[mean_names[i]]], - sd = ald[[sd_names[i]]]) + for (i in 1:n_covariates) { + mean_sd_margins[[i]] <- list(mean = mean_values[i], + sd = sd_values[i]) } # sample covariates from approximate joint distribution using copula diff --git a/R/parse_formula.R b/R/parse_formula.R index 8c78a7d..2e193ec 100644 --- a/R/parse_formula.R +++ b/R/parse_formula.R @@ -53,60 +53,6 @@ get_treatment_name <- function(formula, trt_var = NULL) { guess_treatment_name(formula) } -#' Get mean names -#' -#' @eval study_data_args(include_ipd = FALSE, include_ald = TRUE) -#' @param keep_nms Variable names character vector -#' -#' @return Mean names vector -#' @keywords internal -#' -get_mean_names <- function(ald, keep_nms) { - - dat_names <- names(ald) - # is_sd_name <- grepl(pattern = "\\.mean", dat_names) - is_mean_name <- grepl(pattern = "mean\\.", dat_names) - is_var_name <- grepl(pattern = paste(keep_nms, collapse = "|"), dat_names) - keep_mean_nm <- is_mean_name & is_var_name - - if (all(!keep_mean_nm)) { - warning("No matching mean names found.") - } - - mean_nms <- dat_names[keep_mean_nm] - - covariate_nms <- sub(".*mean\\.", "", mean_nms) - - setNames(mean_nms, covariate_nms) -} - -#' Get standard deviation names -#' -#' @eval study_data_args(include_ipd = FALSE, include_ald = TRUE) -#' @param keep_nms Variable names character vector -#' -#' @return Standard deviation names vector -#' @keywords internal -#' -get_sd_names <- function(ald, keep_nms) { - - dat_names <- names(ald) - # is_sd_name <- grepl(pattern = "\\.sd", dat_names) - is_sd_name <- grepl(pattern = "sd\\.", dat_names) - is_var_name <- grepl(pattern = paste(keep_nms, collapse = "|"), dat_names) - keep_sd_nm <- is_sd_name & is_var_name - - if (all(!keep_sd_nm)) { - warning("No matching sd names found.") - } - - sd_nms <- dat_names[keep_sd_nm] - - covariate_nms <- sub(".*sd\\.", "", sd_nms) - - setNames(sd_nms, covariate_nms) -} - #' Get covariate names #' #' @eval reg_args(include_formula = TRUE, include_family = FALSE) diff --git a/man/calc_ALD_stats.Rd b/man/calc_ALD_stats.Rd index 3142102..1bf8553 100644 --- a/man/calc_ALD_stats.Rd +++ b/man/calc_ALD_stats.Rd @@ -28,9 +28,11 @@ Computes the mean and variance of marginal treatment effects for aggregate-level \examples{ \dontrun{ strategy <- list(family = list(family = "binomial")) # basic version -ald <- data.frame(trial = 1:5, - n_B = c(10, 20, 15, 30, 25), - n_C = c(12, 18, 20, 25, 22)) +ald <- data.frame(trt = c("B","C","B","C"), + variable = c(NA, NA, "y", "y"), + statistic = c("N", "N", "sum", "sum"), + value = c(100, 100, 50, 60) + calc_ALD_stats(strategy, ald, treatments = list("B", "C"), scale = "log") } diff --git a/man/calc_gcomp_ml.Rd b/man/calc_gcomp_ml.Rd index d98bc55..26a326d 100644 --- a/man/calc_gcomp_ml.Rd +++ b/man/calc_gcomp_ml.Rd @@ -22,8 +22,8 @@ calc_gcomp_ml(strategy, ipd, ald) \value{ A list containing: \describe{ -\item{mean_A}{Bootstrap estimates for treatment group A.} -\item{mean_C}{Bootstrap estimates for treatment group C.} +\item{mean_A}{Bootstrap estimates for comparator treatment group "A".} +\item{mean_C}{Bootstrap estimates for reference treatment group "C".} } } \description{ @@ -38,7 +38,9 @@ strategy <- list( trt_var = "treatment", N = 1000 ) -ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +ipd <- data.frame(treatment = c(0, 1), + outcome = c(1, 0), + age = c(30, 40)) ald <- data.frame() calc_gcomp_ml(strategy, ipd, ald) } diff --git a/man/calc_gcomp_stan.Rd b/man/calc_gcomp_stan.Rd index 4daa438..f27bda0 100644 --- a/man/calc_gcomp_stan.Rd +++ b/man/calc_gcomp_stan.Rd @@ -25,8 +25,8 @@ We assume a common distribution for each treatment arm.} \value{ A list of \eqn{y^*_A} and \eqn{y^*_C} posterior predictions: \describe{ -\item{\code{`0`}}{Posterior means for treatment group C.} -\item{\code{`1`}}{Posterior means for treatment group A.} +\item{\code{`0`}}{Posterior means for reference treatment group "C".} +\item{\code{`1`}}{Posterior means for comparator treatment group "A".} } } \description{ @@ -42,7 +42,9 @@ strategy <- list( warmup = 500, chains = 4 ) -ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +ipd <- data.frame(treatment = c(0, 1), + outcome = c(1, 0), + age = c(30, 40)) ald <- data.frame() calc_gcomp_stan(strategy, ipd, ald) } diff --git a/man/calc_stc.Rd b/man/calc_stc.Rd index e322701..ef31223 100644 --- a/man/calc_stc.Rd +++ b/man/calc_stc.Rd @@ -6,6 +6,13 @@ \usage{ calc_stc(strategy, ipd, ...) } +\value{ +A list: +\describe{ +\item{\code{mean_A}}{Mean for comparator treatment group "A".} +\item{\code{mean_C}}{Mean for reference treatment group "C".} +} +} \description{ Calculate simulated treatment comparison statistics } diff --git a/man/calculate_ate.Rd b/man/calculate_ate.Rd index 4297eb0..9ccdb99 100644 --- a/man/calculate_ate.Rd +++ b/man/calculate_ate.Rd @@ -4,10 +4,10 @@ \alias{calculate_ate} \title{Calculate Average Treatment Effect} \usage{ -calculate_ate(mean_A, mean_C, effect) +calculate_ate(mean_comp, mean_ref, effect) } \arguments{ -\item{mean_A, mean_C}{Mean of the outcome for the treatment and control} +\item{mean_comp, mean_ref}{Mean of the outcome for the comparator and reference / common} \item{effect}{A character string specifying the effect scale. Options are: \describe{ @@ -26,7 +26,7 @@ Computes the average treatment effect (ATE) based on the specified effect scale. } \examples{ \dontrun{ -calculate_ate(mean_A = 0.7, mean_C = 0.5, effect = "log_odds") -calculate_ate(mean_A = 0.7, mean_C = 0.5, effect = "risk_difference") +calculate_ate(mean_comp = 0.7, mean_ref = 0.5, effect = "log_odds") +calculate_ate(mean_comp = 0.7, mean_ref = 0.5, effect = "risk_difference") } } diff --git a/man/calculate_trial_variance.Rd b/man/calculate_trial_variance.Rd index eb567a6..ba9083e 100644 --- a/man/calculate_trial_variance.Rd +++ b/man/calculate_trial_variance.Rd @@ -23,7 +23,10 @@ Computes the variance of treatment effects for a trial based on the specified fa } \examples{ \dontrun{ -ald <- data.frame(y.B.sum = c(10), N.B = c(100)) +ald <- data.frame(trt = c("B","C","B","C"), + variable = c(NA, NA, "y", "y"), + statistic = c("N", "N", "sum", "sum"), + value = c(100, 100, 50, 60) calculate_trial_variance(ald, tid = "B", effect = "log_odds", family = "binomial") } } diff --git a/man/get_mean_names.Rd b/man/get_mean_names.Rd deleted file mode 100644 index 18fd992..0000000 --- a/man/get_mean_names.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/parse_formula.R -\name{get_mean_names} -\alias{get_mean_names} -\title{Get mean names} -\usage{ -get_mean_names(ald, keep_nms) -} -\arguments{ -\item{ald}{Aggregate-level data. Single row matrix with summary statistics for each covariate and treatment outcomes. -The format is 'mean.\emph{' and 'sd.}' for covariates and 'y.\emph{.sum', 'y.}.bar', 'y.*.sd' for treatments B and C. -We assume a common distribution for each treatment arm.} - -\item{keep_nms}{Variable names character vector} -} -\value{ -Mean names vector -} -\description{ -Get mean names -} -\keyword{internal} diff --git a/man/get_sd_names.Rd b/man/get_sd_names.Rd deleted file mode 100644 index 087db97..0000000 --- a/man/get_sd_names.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/parse_formula.R -\name{get_sd_names} -\alias{get_sd_names} -\title{Get standard deviation names} -\usage{ -get_sd_names(ald, keep_nms) -} -\arguments{ -\item{ald}{Aggregate-level data. Single row matrix with summary statistics for each covariate and treatment outcomes. -The format is 'mean.\emph{' and 'sd.}' for covariates and 'y.\emph{.sum', 'y.}.bar', 'y.*.sd' for treatments B and C. -We assume a common distribution for each treatment arm.} - -\item{keep_nms}{Variable names character vector} -} -\value{ -Standard deviation names vector -} -\description{ -Get standard deviation names -} -\keyword{internal} diff --git a/man/marginal_treatment_effect.Rd b/man/marginal_treatment_effect.Rd index f8f9a96..c64fbef 100644 --- a/man/marginal_treatment_effect.Rd +++ b/man/marginal_treatment_effect.Rd @@ -29,7 +29,10 @@ so e.g. \eqn{n_{\bar{C}} = N_C - n_c}. } \examples{ \dontrun{ -ald <- data.frame(trial = 1:5, n_B = c(10, 20, 15, 30, 25), n_C = c(12, 18, 20, 25, 22)) +ald <- data.frame(trt = c("B","C","B","C"), + variable = c(NA, NA, "y", "y"), + statistic = c("N", "N", "sum", "sum"), + value = c(100, 100, 50, 60) marginal_treatment_effect(ald, treatments = list("B", "C"), scale = "log", family = "binomial") } } diff --git a/man/marginal_variance.Rd b/man/marginal_variance.Rd index 26add9b..8e6a97a 100644 --- a/man/marginal_variance.Rd +++ b/man/marginal_variance.Rd @@ -25,7 +25,10 @@ For binomial data, calculates: } \examples{ \dontrun{ -ald <- data.frame(trial = 1:5, n_B = c(10, 20, 15, 30, 25), n_C = c(12, 18, 20, 25, 22)) +ald <- data.frame(trt = c("B","C","B","C"), + variable = c(NA, NA, "y", "y"), + statistic = c("N", "N", "sum", "sum"), + value = c(100, 100, 50, 60) marginal_variance(ald, treatments = list("B", "C"), scale = "log", family = "binomial") } } diff --git a/man/reshape_ald_to_long.Rd b/man/reshape_ald_to_long.Rd new file mode 100644 index 0000000..77c8ab1 --- /dev/null +++ b/man/reshape_ald_to_long.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prep_data.R +\name{reshape_ald_to_long} +\alias{reshape_ald_to_long} +\title{Convert from wide to long format} +\usage{ +reshape_ald_to_long(df) +} +\description{ +Convert from wide to long format +} diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index 799e50a..08c3a8f 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -437,10 +437,13 @@ outstandR_stc <- strategy = strategy_stc( formula = lin_form, family = binomial(link = "logit"))) +``` + +```{r} outstandR_stc ``` -Change the outcome scale +Changing the outcome scale to LRR gives ```{r outstandR_stc_lrr} outstandR_stc_lrr <- @@ -502,11 +505,13 @@ outstandR_gcomp_ml <- strategy = strategy_gcomp_ml( formula = lin_form, family = binomial(link = "logit"))) +``` +```{r} outstandR_gcomp_ml ``` -Change the outcome scale +Once again, let us change the outcome scale to LRR ```{r outstandR_gcomp_ml_lrr} outstandR_gcomp_ml_lrr <- From 6a436217279469174770a6dc998c9d1b80ad0e99 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:00:04 +0100 Subject: [PATCH 09/17] Update calc_IPD_stats.R --- R/calc_IPD_stats.R | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/R/calc_IPD_stats.R b/R/calc_IPD_stats.R index cadcfc2..904ff86 100644 --- a/R/calc_IPD_stats.R +++ b/R/calc_IPD_stats.R @@ -7,7 +7,7 @@ #' including Matching-Adjusted Indirect Comparison (MAIC), Simulated Treatment Comparison (STC), #' and G-computation via Maximum Likelihood Estimation (MLE) or Bayesian inference. #' -#' @param strategy A list corresponding to different approaches +#' @param strategy A list corresponding to different modelling approaches #' @eval study_data_args(include_ipd = TRUE, include_ald = TRUE) #' @param scale A scaling parameter for the effect calculation. #' @param ... Additional arguments @@ -20,8 +20,13 @@ #' @examples #' \dontrun{ #' strategy <- strategy_maic() -#' ipd <- data.frame(id = 1:100, treatment = sample(c("A", "C"), 100, replace = TRUE), outcome = rnorm(100)) -#' ald <- data.frame(treatment = c("A", "C"), mean = c(0.2, 0.1), var = c(0.05, 0.03)) +#' ipd <- data.frame(trt = sample(c("A", "C"), 100, replace = TRUE), +#' X1 = rnorm(100, 1, 1), +#' y = rnorm(100, 10, 2)) +#' ald <- data.frame(trt = c(NA, "B", "C", "B", "C"), +#' variable = c("X1", "y", "y", NA, NA), +#' statistic = c("mean", "sum", "sum", "N", "N"), +#' value = c(0.5, 10, 12, 20, 25)) #' calc_IPD_stats(strategy, ipd, ald, scale = "log_odds") #' } #' @export @@ -43,7 +48,7 @@ calc_IPD_stats.default <- function(...) { #' @rdname calc_IPD_stats #' #' @section Multiple imputation marginalisation: -#' Using Stan, compute marginal relative treatment effect for _A_ vs _C_ for each MCMC sample +#' Using Stan, compute marginal relative treatment effect for IPD comparator "A" vs reference "C" arms for each MCMC sample #' by transforming from probability to linear predictor scale. Approximate by #' using imputation and combining estimates using Rubin's rules, in contrast to [calc_IPD_stats.gcomp_stan()]. #' @import stats @@ -86,7 +91,7 @@ calc_IPD_stats.mim <- function(strategy, #' Factory function for creating calc_IPD_stats methods #' -#' Creates a method for computing mean and variance statistics based on the supplied function. +#' Creates a method for computing IPD mean and variance statistics based on the supplied function. #' #' @param ipd_fun A function that computes mean and variance statistics for individual-level patient data. #' @return A function that computes mean and variance statistics for a given strategy. @@ -128,7 +133,7 @@ IPD_stat_factory <- function(ipd_fun) { #' @rdname calc_IPD_stats #' @section Simulated treatment comparison statistics: -#' IPD from the _AC_ trial are used to fit a regression model describing the +#' IPD for reference "C" and comparator "A" trial arms are used to fit a regression model describing the #' observed outcomes \eqn{y} in terms of the relevant baseline characteristics \eqn{x} and #' the treatment variable \eqn{z}. #' @export @@ -137,7 +142,7 @@ calc_IPD_stats.stc <- IPD_stat_factory(outstandR:::calc_stc) #' @rdname calc_IPD_stats #' @section Matching-adjusted indirect comparison statistics: -#' Marginal _A_ vs _C_ treatment effect estimates +#' Marginal IPD comparator treatment "A" vs reference treatment "C" treatment effect estimates #' using bootstrapping sampling. #' @export #' @@ -152,7 +157,7 @@ calc_IPD_stats.gcomp_ml <- IPD_stat_factory(outstandR:::calc_gcomp_ml) #' @rdname calc_IPD_stats #' @section G-computation Bayesian statistics: -#' Using Stan, compute marginal log-odds ratio for _A_ vs _C_ for each MCMC sample +#' Using Stan, compute marginal relative effects for IPD comparator "A" vs reference "C" treatment arms for each MCMC sample #' by transforming from probability to linear predictor scale. #' @export #' From a0570351a183e393e60e964c8136a6657541be2e Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:10:17 +0100 Subject: [PATCH 10/17] Update gcomp_ml.R --- R/gcomp_ml.R | 37 +++++++++++++++++-------------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/R/gcomp_ml.R b/R/gcomp_ml.R index 15af05f..61cc5ae 100644 --- a/R/gcomp_ml.R +++ b/R/gcomp_ml.R @@ -1,21 +1,23 @@ #' G-computation maximum likelihood bootstrap #' -#' Using bootstrap resampling, calculates the log odds ratio. +#' Using bootstrap resampling, calculates the relative treatment effect, +#' such as log odds ratio, log relative risk or risk difference. #' -#' @param data Trial data -#' @param indices Indices sampled from rows of `data` +#' @param data IPD trial data +#' @param indices Indices sampled from rows of `data` for bootstrapping #' @eval reg_args(include_formula = TRUE, include_family = TRUE) #' @param rho A named square matrix of covariate correlations; default NA. #' @param N Synthetic sample size for g-computation #' @param ald Aggregate-level data for covariates. #' -#' @return Mean difference in expected log-odds +#' @return Relative treatment effect #' @seealso [strategy_gcomp_ml()], [gcomp_ml_log_odds_ratio()] #' @examples #' \dontrun{ -#' data <- data.frame(treatment = c(0, 1), outcome = c(1, 0)) -#' gcomp_ml.boot(data, indices = 1:2, formula = outcome ~ treatment, +#' data <- data.frame(trt = c("A", "C"), +#' y = c(1, 0)) +#' gcomp_ml.boot(data, indices = 1:2, formula = y ~ trt, #' R = 100, family = binomial(), N = 1000, ald = NULL) #' } #' @keywords internal @@ -32,28 +34,24 @@ gcomp_ml.boot <- function(data, indices, } -#' G-computation Maximum Likelihood mean outcome -#' -#' @section Log-Odds Ratio: -#' Marginal _A_ vs _C_ log-odds ratio (mean difference in expected log-odds) -#' estimated by transforming from probability to linear predictor scale. -#' -#' \eqn{\log(\hat{\mu}_A/(1 - \hat{\mu}_A)) - \log(\hat{\mu}_C/(1 - \hat{\mu}_C))} +#' G-computation maximum likelihood mean outcomes by arm #' #' @eval reg_args(include_formula = TRUE, include_family = TRUE) #' @eval study_data_args(include_ipd = TRUE, include_ald = TRUE) #' @param rho A named square matrix of covariate correlations; default NA. #' @param N Synthetic sample size for g-computation #' -#' @return A named vector containing the marginal mean probabilities under treatments A (`0`) and C (`1`). +#' @return A named vector containing the marginal mean probabilities under +#' comparator "A" (`0`) and reference "C" (`1`) treatments. #' @seealso [strategy_gcomp_ml()], [gcomp_ml.boot()] #' @importFrom copula normalCopula mvdc rMvdc #' @importFrom stats predict glm #' @examples #' \dontrun{ -#' formula <- outcome ~ treatment +#' formula <- y ~ trt #' family <- binomial() -#' ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0)) +#' ipd <- data.frame(trt = c("A", "C"), +#' y = c(1, 0)) #' ald <- data.frame() #' gcomp_ml_means(formula, family, N = 1000, ipd = ipd, ald = ald) #' } @@ -108,10 +106,10 @@ gcomp_ml_means <- function(formula, #' @importFrom copula normalCopula mvdc #' @examples #' \dontrun{ -#' formula <- outcome ~ treatment + age -#' ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +#' formula <- y ~ trt + age +#' ipd <- data.frame(tr = c("A", "C"), y = c(1, 0), age = c(30, 40)) #' ald <- data.frame() -#' simulate_ALD_pseudo_pop(formula, ipd, ald, trt_var = "treatment", N = 1000) +#' simulate_ALD_pseudo_pop(formula, ipd, ald, trt_var = "trt", N = 1000) #' } #' @keywords internal #' @@ -187,4 +185,3 @@ simulate_ALD_pseudo_pop <- function(formula, ## what about binary? threshold? x_star } - From b81c7b70cfeeb5fb1b42ecac8216bcc149a87cec Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:13:48 +0100 Subject: [PATCH 11/17] Update gcomp_stan.R --- R/gcomp_stan.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/gcomp_stan.R b/R/gcomp_stan.R index 82212f1..8d7e6d9 100644 --- a/R/gcomp_stan.R +++ b/R/gcomp_stan.R @@ -24,14 +24,14 @@ #' @examples #' \dontrun{ #' strategy <- list( -#' formula = outcome ~ treatment + age, +#' formula = y ~ trt + age, #' family = binomial(), #' iter = 2000, #' warmup = 500, #' chains = 4 #' ) -#' ipd <- data.frame(treatment = c(0, 1), -#' outcome = c(1, 0), +#' ipd <- data.frame(trt = c("A", "C"), +#' y = c(1, 0), #' age = c(30, 40)) #' ald <- data.frame() #' calc_gcomp_stan(strategy, ipd, ald) @@ -102,13 +102,13 @@ calc_gcomp_stan <- function(strategy, #' \dontrun{ #' strategy <- list( #' R = 1000, -#' formula = outcome ~ treatment + age, +#' formula = y ~ trt + age, #' family = binomial(), #' trt_var = "treatment", #' N = 1000 #' ) -#' ipd <- data.frame(treatment = c(0, 1), -#' outcome = c(1, 0), +#' ipd <- data.frame(trt = c("A", "C"), +#' y = c(1, 0), #' age = c(30, 40)) #' ald <- data.frame() #' calc_gcomp_ml(strategy, ipd, ald) From 3a0e58d13886285b6168b045f7ba2486f2215ce7 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:15:25 +0100 Subject: [PATCH 12/17] Update result_stats.R --- R/result_stats.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/result_stats.R b/R/result_stats.R index 9d3d67b..178c7b7 100644 --- a/R/result_stats.R +++ b/R/result_stats.R @@ -5,7 +5,7 @@ #' adjusted individual level data studies AC into a single object. #' #' @param ipd_stats,ald_stats -#' @param CI Confidence interval 1-alpha +#' @param CI Confidence interval 1-alpha; dafault 0.95 #' #' @returns List #' @keywords internal From d2dc0b67476429f1aace4b853562df19e79ed58e Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:16:17 +0100 Subject: [PATCH 13/17] Update validate_outstandr.R --- R/validate_outstandr.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/validate_outstandr.R b/R/validate_outstandr.R index 7676e88..741128f 100644 --- a/R/validate_outstandr.R +++ b/R/validate_outstandr.R @@ -1,5 +1,6 @@ -# +#' Input data validator +#' @keyword internal validate_outstandr <- function(ipd_trial, ald_trial, strategy, CI, scale) { From 44a13632048ec0de06fb98ccbda74a8a531b5845 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Sun, 18 May 2025 12:18:22 +0100 Subject: [PATCH 14/17] Update calc_ALD_stats.R --- R/calc_ALD_stats.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/calc_ALD_stats.R b/R/calc_ALD_stats.R index f46c30b..ea11950 100644 --- a/R/calc_ALD_stats.R +++ b/R/calc_ALD_stats.R @@ -45,8 +45,6 @@ calc_ALD_stats <- function(strategy, #' Marginal effect variance using the delta method #' #' Computes the total variance of marginal treatment effects using the delta method. -#' For binomial data, calculates: -#' \deqn{\frac{1}{n_C} + \frac{1}{n_{\bar{C}}} + \frac{1}{n_B} + \frac{1}{n_{\bar{B}}}}. #' #' @param ald Aggregate-level data #' @param treatments A list of treatment labels; default _B_ vs _C_ @@ -78,12 +76,6 @@ marginal_variance <- function(ald, #' Marginal treatment effect from reported event counts #' #' Computes the relative treatment effect from aggregate-level data using event counts. -#' For binomial data, calculates: -#' \deqn{ -#' \log\left( \frac{n_B/(N_B-n_B)}{n_C/(N_B-n_{B})} \right) = \log(n_B n_{\bar{C}}) - \log(n_C n_{\bar{B}}) -#' } -#' where \eqn{\bar{C}} is the compliment of \eqn{C} -#' so e.g. \eqn{n_{\bar{C}} = N_C - n_c}. #' #' @param ald Aggregate-level data #' @param treatments A list of treatment labels. Last variable is reference; default `B`, `C` (common; e.g. placebo) From b545d5f130a48b092f952c8a10f7617bccfd2839 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Mon, 19 May 2025 10:09:17 +0100 Subject: [PATCH 15/17] binary data vignette looks like its ok now moving on to the other data types --- vignettes/Binary_data_example.Rmd | 407 +++++++++++++++++------------- 1 file changed, 232 insertions(+), 175 deletions(-) diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index 08c3a8f..dea635c 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -20,59 +20,85 @@ knitr::opts_chunk$set( ## Introduction -Population adjustment methods such as *matching-adjusted indirect -comparison* (MAIC) are increasingly used to compare marginal treatment -effects when there are cross-trial differences in effect modifiers and -limited patient-level data. MAIC is based on propensity score weighting, -which is sensitive to poor covariate overlap and cannot extrapolate -beyond the observed covariate space. Current outcome regression-based -alternatives can extrapolate but target a conditional treatment effect -that is incompatible in the indirect comparison. When adjusting for -covariates, one must integrate or average the conditional estimate over -the relevant population to recover a compatible marginal treatment -effect. - -We propose a marginalization method based on *parametric G-computation* -that can be easily applied where the outcome regression is a generalized -linear model or a Cox model. The approach views the covariate adjustment -regression as a nuisance model and separates its estimation from the -evaluation of the marginal treatment effect of interest. The method can -accommodate a Bayesian statistical framework, which naturally integrates -the analysis into a probabilistic framework. A simulation study provides -proof-of-principle and benchmarks the method's performance against MAIC -and the conventional outcome regression. Parametric G-computation -achieves more precise and more accurate estimates than MAIC, -particularly when covariate overlap is poor, and yields unbiased -marginal treatment effect estimates under no failures of assumptions. -Furthermore, the marginalized regression-adjusted estimates provide -greater precision and accuracy than the conditional estimates produced -by the conventional outcome regression. +Population adjustment methods are increasingly used to compare marginal +treatment effects when there are cross-trial differences in effect +modifiers and limited patient-level data. + +The `{outstandR}` package allows the implementation of a range of +methods for this situation including the following: + +- *Matching-Adjusted Indirect Comparison (MAIC)* is based on + propensity score weighting, which is sensitive to poor covariate + overlap and cannot extrapolate beyond the observed covariate space. + It reweights the individual patient-level data (IPD) to match the + aggregate characteristics of the comparator trial, thereby aligning + the populations. + +- *Simulated Treatment Comparison (STC)* relies on outcome regression + models fitted to IPD, conditioning on covariates to estimate the + effect of treatment. These estimates are then applied to the + aggregate-level comparator population. Like MAIC, STC is limited by + its conditional nature and can produce biased marginal estimates if + not properly marginalized. + +- *Parametric G-computation with maximum likelihood*: This method fits + an outcome model to the IPD using maximum likelihood estimation, + then uses that model to predict outcomes in the comparator + population. It allows extrapolation beyond the observed covariate + space but requires correct specification of the outcome model to + avoid bias. + +- *Parametric G-computation with Bayesian inference*: Similar to the + maximum likelihood version, this approach fits an outcome model but + within a Bayesian framework. It allows coherent propagation of + uncertainty through prior distributions and posterior inference, + enabling probabilistic sensitivity analysis and full uncertainty + quantification. + +- *Marginalization method based on parametric G-computation*: Current + outcome regression-based alternatives can extrapolate but target a + conditional treatment effect that is incompatible in the indirect + comparison. When adjusting for covariates, one must integrate or + average the conditional estimate over the relevant population to + recover a compatible marginal treatment effect. This can be easily + applied where the outcome regression is a generalized linear model + or a Cox model. The approach views the covariate adjustment + regression as a nuisance model and separates its estimation from the + evaluation of the marginal treatment effect of interest. The method + can accommodate a Bayesian statistical framework, which naturally + integrates the analysis into a probabilistic framework. + +We will now demonstrate the use of the `{outstandR}` package to fit all +of these types of models to simulated binary data. Other vignettes will +provide equivalent analyses for continuous and count data. ## General problem -Consider one trial, for which the company has IPD, comparing treatments *A* and *C*, from herein call the *AC* trial. -Also, consider a second trial comparing treatments *B* and *C*, similarly called the *BC* trial. For this trial only published aggregate data are available. -We wish to estimate a comparison of the effects of treatments *A* and *B* on an +Consider one trial, for which the company has IPD, comparing treatments +*A* and *C*, from herein call the *AC* trial. Also, consider a second +trial comparing treatments *B* and *C*, similarly called the *BC* trial. +For this trial only published aggregate data are available. We wish to +estimate a comparison of the effects of treatments *A* and *B* on an appropriate scale in some target population *P*, denoted by the parameter $d_{AB(P)}$. We make use of bracketed subscripts to denote a specific population. Within the *BC* population there are parameters -$\mu_{B(BC)}$ and $\mu_{C(BC)}$ representing the -expected outcome on each treatment (including parameters for treatments -not studied in the *BC* trial, e.g. treatment *A*). The *BC* trial -provides estimators $\bar{Y}_{B(BC)}$ and $\bar{Y}_{C(BC)}$ of -$\mu_{B(BC)}$, $\mu_{C(BC)}$, respectively, which are the summary -outcomes. It is the same situation for the *AC* trial. - -For a suitable scale, for example a log-odds ratio, or risk difference, we form -estimators $\Delta_{BC(BC)}$ and $\Delta_{AC(AC)}$ of the trial level -(or marginal) relative treatment effects. We shall assume that this is always represented as a difference so, for example, -for the risk ratio this is on the log scale. +$\mu_{B(BC)}$ and $\mu_{C(BC)}$ representing the expected outcome on +each treatment (including parameters for treatments not studied in the +*BC* trial, e.g. treatment *A*). The *BC* trial provides estimators +$\bar{Y}_{B(BC)}$ and $\bar{Y}_{C(BC)}$ of $\mu_{B(BC)}$, $\mu_{C(BC)}$, +respectively, which are the summary outcomes. It is the same situation +for the *AC* trial. + +For a suitable scale, for example a log-odds ratio, or risk difference, +we form estimators $\Delta_{BC(BC)}$ and $\Delta_{AC(AC)}$ of the trial +level (or marginal) relative treatment effects. We shall assume that +this is always represented as a difference so, for example, for the risk +ratio this is on the log scale. $$ \Delta_{AB(BC)} = g(\bar{Y}_{B{(BC)}}) - g(\bar{Y}_{A{(BC)}}) $$ - ## Example analysis First, let us load necessary packages. @@ -81,17 +107,18 @@ First, let us load necessary packages. library(boot) # non-parametric bootstrap in MAIC and ML G-computation library(copula) # simulating BC covariates from Gaussian copula library(rstanarm) # fit outcome regression, draw outcomes in Bayesian G-computation +library(tidyr) library(outstandR) library(simcovariates) ``` ### Data -We consider binary outcomes using the log-odds ratio as the measure of effect. -For example, the binary outcome may be response to treatment or the occurrence of an -adverse event. For trials *AC* and *BC*, outcome $y_i$ for subject $i$ -is simulated from a Bernoulli distribution with probabilities of success -generated from logistic regression. +We consider binary outcomes using the log-odds ratio as the measure of +effect. For example, the binary outcome may be response to treatment or +the occurrence of an adverse event. For trials *AC* and *BC*, outcome +$y_i$ for subject $i$ is simulated from a Bernoulli distribution with +probabilities of success generated from logistic regression. For the *BC* trial, the individual-level covariates and outcomes are aggregated to obtain summaries. The continuous covariates are summarized @@ -101,30 +128,30 @@ the RCT publication. The binary outcomes are summarized in an overall event table. Typically, the published study only provides aggregate information to the analyst. -The IPD simulation input parameters are given below. - -| Parameter | Description | Value | -|------------------|--------------------------------------------------------------------|------------------| -| `N` | Sample size | 200 | -| `allocation` | Active treatment vs. placebo allocation ratio (2:1) | 2/3 | -| `b_trt` | Conditional effect of active treatment vs. comparator (log(0.17)) | -1.77196 | -| `b_X` | Conditional effect of each prognostic variable (-log(0.5)) | 0.69315 | -| `b_EM` | Conditional interaction effect of each effect modifier (-log(0.67))| 0.40048 | -| `meanX_AC[1]` | Mean of prognostic factor X3 in AC trial | 0.45 | -| `meanX_AC[2]` | Mean of prognostic factor X4 in AC trial | 0.45 | -| `meanX_EM_AC[1]` | Mean of effect modifier X1 in AC trial | 0.45 | -| `meanX_EM_AC[2]` | Mean of effect modifier X2 in AC trial | 0.45 | -| `meanX_BC[1]` | Mean of prognostic factor X3 in BC trial | 0.6 | -| `meanX_BC[2]` | Mean of prognostic factor X4 in BC trial | 0.6 | -| `meanX_EM_BC[1]` | Mean of effect modifier X1 in BC trial | 0.6 | -| `meanX_EM_BC[2]` | Mean of effect modifier X2 in BC trial | 0.6 | -| `sdX` | Standard deviation of prognostic factors (AC and BC) | 0.4 | -| `sdX_EM` | Standard deviation of effect modifiers | 0.4 | -| `corX` | Covariate correlation coefficient | 0.2 | -| `b_0` | Baseline intercept | -0.6 | - - -We shall use the `gen_data()` function available with the [simcovariates](https://github.com/n8thangreen/simcovariates) package. +The simulation input parameters are given below. + +| Parameter | Description | Value | +|------------------|-------------------------------------|------------------| +| `N` | Sample size | 200 | +| `allocation` | Active treatment vs. placebo allocation ratio (2:1) | 2/3 | +| `b_trt` | Conditional effect of active treatment vs. comparator (log(0.17)) | -1.77196 | +| `b_X` | Conditional effect of each prognostic variable (-log(0.5)) | 0.69315 | +| `b_EM` | Conditional interaction effect of each effect modifier (-log(0.67)) | 0.40048 | +| `meanX_AC[1]` | Mean of prognostic factor X3 in AC trial | 0.45 | +| `meanX_AC[2]` | Mean of prognostic factor X4 in AC trial | 0.45 | +| `meanX_EM_AC[1]` | Mean of effect modifier X1 in AC trial | 0.45 | +| `meanX_EM_AC[2]` | Mean of effect modifier X2 in AC trial | 0.45 | +| `meanX_BC[1]` | Mean of prognostic factor X3 in BC trial | 0.6 | +| `meanX_BC[2]` | Mean of prognostic factor X4 in BC trial | 0.6 | +| `meanX_EM_BC[1]` | Mean of effect modifier X1 in BC trial | 0.6 | +| `meanX_EM_BC[2]` | Mean of effect modifier X2 in BC trial | 0.6 | +| `sdX` | Standard deviation of prognostic factors (AC and BC) | 0.4 | +| `sdX_EM` | Standard deviation of effect modifiers | 0.4 | +| `corX` | Covariate correlation coefficient | 0.2 | +| `b_0` | Baseline intercept | -0.6 | + +We shall use the `gen_data()` function available with the +[simcovariates](https://github.com/n8thangreen/simcovariates) package. ```{r, warning=FALSE, message=FALSE} library(dplyr) @@ -151,15 +178,19 @@ ipd_trial <- gen_data(N, b_trt, b_X, b_EM, b_0, family = binomial("logit")) ``` -The treatment column in the return data is binary and takes values 0 and 1. We will include some extra information about treatment names. -To do this we will define the lable of the two level factor as `A` for 1 and `C` for 0 as follows. +The treatment column in the return data is binary and takes values 0 +and 1. We will include some extra information about treatment names. To +do this we will define the lable of the two level factor as `A` for 1 +and `C` for 0 as follows. ```{r} ipd_trial$trt <- factor(ipd_trial$trt, labels = c("C", "A")) ``` -Similarly, to obtain the aggregate data we will simulate IPD but with the additional summarise step. -We set different mean values `meanX_BC` and `meanX_EM_BC` but otherwise use the same parameter values as for the $AC$ trial. +Similarly, to obtain the aggregate data we will simulate IPD but with +the additional summarise step. We set different mean values `meanX_BC` +and `meanX_EM_BC` but otherwise use the same parameter values as for the +$AC$ trial. ```{r generate-ald-data} BC.IPD <- gen_data(N, b_trt, b_X, b_EM, b_0, @@ -214,7 +245,8 @@ summary.N <- ald_trial <- rbind.data.frame(cov.X, summary.y, summary.N) ``` -This general format of the data sets are in a 'long' style consisting of the following. +This general format of the data sets are in a 'long' style consisting of +the following. #### `ipd_trial`: Individual patient data @@ -224,10 +256,13 @@ This general format of the data sets are in a 'long' style consisting of the fol #### `ald_trial`: Aggregate-level data -- `variable`: Covariate name. In the case of treatment arm sample size this is `NA` -- `statistic`: Summary statistic name from mean, standard deviation or sum +- `variable`: Covariate name. In the case of treatment arm sample size + this is `NA` +- `statistic`: Summary statistic name from mean, standard deviation or + sum - `value`: Numerical value of summary statistic -- `trt`: Treatment label. Because we assume a common covariate distribution between treatment arms this is `NA` +- `trt`: Treatment label. Because we assume a common covariate + distribution between treatment arms this is `NA` Our data look like the following. @@ -235,14 +270,18 @@ Our data look like the following. head(ipd_trial) ``` -There are 4 correlated continuous covariates generated per subject, simulated from a multivariate normal distribution. -Treatment `trt` takes either new treatment *A* or standard of care or status quo *C*. The ITC is 'anchored' via *C*, the common treatment. +There are 4 correlated continuous covariates generated per subject, +simulated from a multivariate normal distribution. Treatment `trt` takes +either new treatment *A* or standard of care or status quo *C*. The ITC +is 'anchored' via *C*, the common treatment. ```{r} ald_trial ``` -In this case, we have 4 covariate mean and standard deviation values; and the event total, average and sample size for each treatment *B*, and *C*. +In this case, we have 4 covariate mean and standard deviation values; +and the event total, average and sample size for each treatment *B* and +*C*. #### Regression model @@ -252,14 +291,19 @@ $$ \text{logit}(p_{t}) = \beta_0 + \beta_X (X_3 + X_4) + [\beta_{t} + \beta_{EM} (X_1 + X_2)] \; \text{I}(t \neq C) $$ -That is, for treatment $C$ the right hand side becomes $\beta_0 + \beta_X (X_3 + X_4)$ and for comparator treatments $A$ or $B$ there is an additional $\beta_t + \beta_{EM} (X_1 + X_2)$ component consisting of the effect modifier terms and the coefficient for the treatment parameter is the log odds-ratio (LOR), $\beta_t$ (or `b_trt` in the R code). -$p_{t}$ is the probability of experiencing the event of interest for treatment $t$. +$\text{I}()$ is an indicator function taking value 1 if true and 0 otherwise. +That is, for treatment $C$ the right hand side becomes +$\beta_0 + \beta_X (X_3 + X_4)$ and for comparator treatments $A$ or $B$ +there is an additional $\beta_t + \beta_{EM} (X_1 + X_2)$ component +consisting of the effect modifier terms and the coefficient for the +treatment parameter, $\beta_t$ (or `b_trt` in the R code), i.e. the log odds-ratio (LOR) for the logit model. +Finally, $p_{t}$ is the probability of experiencing the event of interest for treatment $t$. ### Output statistics -We will implement for MAIC, STC, and G-computation methods to obtain the *marginal treatment effect* and *marginal variance*. -The definition by which these are calculated depends on the type of data and outcome scale. -For our current example of binary data and log-odds ratio the marginal treatment effect is +We will obtain the *marginal treatment effect* and *marginal variance*. +The definition by which of these are calculated depends on the type of data and outcome +scale. For our current example of binary data and log-odds ratio the marginal treatment effect is $$ \log\left( \frac{n_B/(N_B-n_B)}{n_C/(N_B-n_{B})} \right) = \log(n_B n_{\bar{C}}) - \log(n_C n_{\bar{B}}) @@ -270,16 +314,17 @@ and marginal variance is $$ \frac{1}{n_C} + \frac{1}{n_{\bar{C}}} + \frac{1}{n_B} + \frac{1}{n_{\bar{B}}} $$ -where $n_B, n_C$ are the number of events in each arm and $\bar{C}$ is the compliment of $C$, so e.g. $n_{\bar{C}} = N_C - n_c$. -Other scales will be discussed below. + +where $n_B, n_C$ are the number of events in each arm and $\bar{C}$ +is the compliment of $C$, so e.g. $n_{\bar{C}} = N_C - n_c$. Other outcome scales will be discussed below. ## Model fitting in R The `{outstandR}` package has been written to be easy to use and -essential consists of a single function, `outstandR()`. This can be used -to run all of the different types of model, which we will call -*strategies*. The first two arguments of `outstandR()` are the -individual and aggregate-level data, respectively. +essentially consists of a single function, `outstandR()`. This can be used +to run all of the different types of model, which when combined with their specific parameters +we will call *strategies*. The first two arguments of `outstandR()` are the +individual patient and aggregate-level data, respectively. A `strategy` argument of `outstandR` takes functions called `strategy_*()`, where the wildcard `*` is replaced by the name of the @@ -288,13 +333,17 @@ specific example is provided below. ### Model formula -Defining $X_1, X_2$ as effect modifiers, $X_3, X_4$ as prognostic variables and $Z$ the treatment indicator then the formula used in this model is +We will take advantage of the in-built R formula object to define the models. +This will allow us easily pull out components of the object and consistently use it. +Defining $X_1, X_2$ as effect modifiers, $X_3, X_4$ as prognostic +variables and $Z$ the treatment indicator then the formula used in this +model is $$ y = X_3 + X_4 + Z + Z X_1 + Z X_2 $$ - -which corresponds to the following `R` `formula` object passed as an +Notice that this does not include the link function of interest so appears as a linear regression. +This corresponds to the following `R` `formula` object passed as an argument to the strategy function. ```{r} @@ -307,15 +356,23 @@ Note that the more succinct formula y ~ X3 + X4 + trt*(X1 + X2) ``` -Would also include $X_1, X_2$ as prognostic factors so in not equivalent, but could be modified as follows. +Would additionally include $X_1, X_2$ as prognostic factors so in not +equivalent, but could be modified as follows. ```{r, eval=FALSE} y ~ X3 + X4 + trt*(X1 + X2) - X1 - X2 ``` -### MAIC +We note that the MAIC approach does not strictly use a regression in the same way as the other methods so should not be considered directly comparable in this sense +but we have decided to use a consistent syntax across models using 'formula'. + -Using the individual level data for *AC* firstly we perform +### Matching-Adjusted Indirect Comparison (MAIC) + +A single call to `outstandR()` is sufficient to run the model. We pass to the `strategy` argument +the `strategy_maic()` function with arguments `formula = lin_form` as defined above and `family = binomial(link = "logit")` for binary data and logistic link. + +Internally, using the individual patient level data for *AC* firstly we perform non-parametric bootstrap of the `maic.boot` function with `R = 1000` replicates. This function fits treatment coefficient for the marginal effect for *A* vs *C*. The returned value is an object of class `boot` @@ -336,62 +393,72 @@ The returned object is of class `outstandR`. str(outstandR_maic) ``` -We see that this is a list object with 3 parts, each containing +We see that this is a list object with 2 parts. The first contains statistics between each pair of treatments. These are the mean contrasts, variances and confidence intervals (CI), respectively. The -default CI is for 95% but can be altered in `outstandR` with the `CI` argument. +default CI is for 95% but can be altered in `outstandR` with the `CI` +argument. The second element of the list contains the absolute effect estimates. -A `print` method is available for `outstandR` objects for more human-readable output +A `print` method is available for `outstandR` objects for more +human-readable output ```{r} outstandR_maic ``` - #### Outcome scale -If we do not explicitly specify the outcome scale, the default is that used to fit to the data in the regression model. As we saw, in this case, the default is -log-odds ratio corresponding to the `"logit"` link function for binary data. -However, we can change this to some other scale which may be more appropriate for a particular analysis. -So far implemented in the package, the links and their corresponding relative treatment effect scales are as follows: +If we do not explicitly specify the outcome scale, the default is that +used to fit to the data in the regression model. As we saw, in this +case, the default is log-odds ratio corresponding to the `"logit"` link +function for binary data. However, we can change this to some other +scale which may be more appropriate for a particular analysis. So far +implemented in the package, the links and their corresponding relative +treatment effect scales are as follows: -| Data Type | Model | Scale | Argument | -|:-----------|---------|:------------------|:-------------------| -| Binary | `logit` | Log-odds ratio | `log_odds` | -| Count | `log` | Log-risk ratio | `log_relative_risk`| -| Continuous | `mean` | Mean difference | `risk_difference` | +| Data Type | Model | Scale | Argument | +|:-----------|---------|:----------------|:--------------------| +| Binary | `logit` | Log-odds ratio | `log_odds` | +| Count | `log` | Log-risk ratio | `log_relative_risk` | +| Continuous | `mean` | Mean difference | `risk_difference` | -The full list of possible transformed treatment effect scales are: -log-odds ratio, log-risk ratio, mean difference, risk difference, hazard ratio, hazard difference. +The full list of possible transformed treatment effect scales will be: +log-odds ratio, log-risk ratio, mean difference, risk difference, hazard +ratio, hazard difference. For binary data the marginal treatment effect and variance are -* __Log-risk ratio__ +- **Log-risk ratio** Treatment effect is + $$ \log(n_B/N_B) - \log(n_A/N_A) $$ + and variance + $$ \frac{1}{n_B} - \frac{1}{N_B} + \frac{1}{n_A} - \frac{1}{N_A} $$ - -* __Risk difference__ +- **Risk difference** Treatment effect is + $$ \frac{n_B}{N_B} - \frac{n_A}{N_A} $$ + and variance + $$ \frac{n_B}{N_B} \left( 1 - \frac{n_B}{N_B} \right) + \frac{n_A}{N_A} \left( 1 - \frac{n_A}{N_A} \right) $$ - -To change the outcome scale, we can pass the `scale` argument in the `outstandR()` function. -For example, to change the scale to risk difference, we can use the following code. +To change the outcome scale, we can pass the `scale` argument in the +`outstandR()` function. For example, to change the scale to risk +difference, we can use the following code. ```{r outstandR_maic_lrr} outstandR_maic_lrr <- @@ -407,29 +474,11 @@ outstandR_maic_lrr ### Simulated treatment comparison -Simulated treatment comparison (STC) is the conventional outcome regression method. It involves fitting a -regression model of outcome on treatment and covariates to the IPD. IPD -effect modifiers are centred at the mean *BC* values. - -$$ -g(\mu_n) = \beta_0 + \beta_X (\boldsymbol{x}_n - \boldsymbol{\theta}) + \boldsymbol{\beta_{EM}} (\beta_t + (\boldsymbol{x_n^{EM}} - \boldsymbol{\theta^{EM}}) ) \; \mbox{I}(t \neq C) -$$ +Simulated treatment comparison (STC) is the conventional outcome +regression method. It involves fitting a regression model of outcome on +treatment and covariates to the IPD. -where $\beta_0$ is the intercept, $\beta_1$ are the covariate -coefficients, $\beta_z$ and $\beta_2$ are the effect modifier -coefficients, $z_n$ are the indicator variables of effect alternative -treatment. $g(\cdot)$ is the link function e.g. $\log$. - -As already mentioned, running the STC analysis is almost identical to -the previous analysis but we now use the `strategy_stc()` strategy -function instead and a formula with centered covariates. - -$$ -y = X_3 + X_4 + Z + Z (X_1 - \bar{X_1}) + Z (X_2 - \bar{X_2}) -$$ - -However, `outstandR()` knows how to handle this so we can simply pass -the same (uncentred) formula as before. +We can simply pass the same formula as before to the modified call with `strategy_stc()`. ```{r outstandR_stc} outstandR_stc <- @@ -489,15 +538,7 @@ $$ \hat{\mu}_0 = \int_{x^*} g^{-1} (\hat{\beta}_0 + x^* \hat{\beta}_1 ) p(x^*) \; \text{d}x^* $$ -To estimate the marginal or population-average treatment effect for *A* -versus *C* in the linear predictor scale, one back-transforms to this -scale the average predictions, taken over all subjects on the natural -outcome scale, and calculates the difference between the average linear -predictions: - -$$ -\hat{\Delta}^{(2)}_{10} = g(\hat{\mu}_1) - g(\hat{\mu}_0) -$$ +As performed for the previous approaches, call `outstandR()` but change the strategy to `strategy_gcomp_ml()`, ```{r outstandR_gcomp_ml} outstandR_gcomp_ml <- @@ -557,9 +598,7 @@ full Bayesian estimation via Markov chain Monte Carlo (MCMC) sampling. The average, variance and interval estimates of the marginal treatment effect can be derived empirically from draws of the posterior density. -We can draw a vector of size $N^*$ of predicted outcomes $y^*_z$ under -each set intervention $z^*$ from its posterior predictive distribution -under the specific treatment. +The strategy function to plug-in to the `outstandR()` call for this approach is `strategy_gcomp_stan()`, ```{r outstandR_gcomp_stan, message=FALSE, eval=FALSE} outstandR_gcomp_stan <- @@ -582,7 +621,7 @@ xx <- capture.output( outstandR_gcomp_stan ``` -As before, we can change the outcome scale. +As before, we can change the outcome scale to LRR. ```{r outstandR_gcomp_stan_lrr, eval=FALSE} outstandR_gcomp_stan_lrr <- @@ -609,7 +648,8 @@ outstandR_gcomp_stan_lrr ### Multiple imputation marginalisation -Marginalized treatment effect for aggregate level data study is obtained by integrating over the covariate distribution from the $BC$ study +The final method is to obtain the marginalized treatment effect for aggregate level data study, obtained +by integrating over the covariate distribution from the aggregate level data $BC$ study $$ \Delta^{\text{marg}} = \mathbb{E}_{X \sim f_{\text{BC}}(X)} \left[ \mu_{T=1}(X) - \mu_{T=0}(X) \right] @@ -622,14 +662,14 @@ $$ \hat{\Delta}_{BC} \sim \mathcal{N}(\Delta^{\text{marg}}, SE^2) $$ +The multiple imputation marginalisation strategy function is `strategy_mim()`, + ```{r outstandR_mim, eval=FALSE} outstandR_mim <- outstandR(ipd_trial, ald_trial, strategy = strategy_mim( formula = lin_form, family = binomial(link = "logit"))) - -outstandR_mim ``` ```{r outstandR_mim_eval, echo=FALSE} @@ -645,7 +685,7 @@ xx <- capture.output( outstandR_mim ``` -Change the outcome scale again. +Change the outcome scale again for LRR, ```{r outstandR_mim_lrr, eval=FALSE} outstandR_mim_lrr <- @@ -670,15 +710,19 @@ xx <- capture.output( outstandR_mim_lrr ``` -### Model comparison + +## Model comparison #### $AC$ effect in $BC$ population The true $AC$ effect on the log OR scale in the $BC$ (aggregate trial data) population is -$\beta_t^{AC} + \beta_{EM} (\bar{X}^{AC}_1 + \bar{X}_2^{AC})$. Calculated by +$\beta_t^{AC} + \beta_{EM} (\bar{X}^{AC}_1 + \bar{X}_2^{AC})$. Calculated by ```{r} -d_AC_true <- b_trt + b_EM * (ald_trial$mean.X1 + ald_trial$mean.X2) +mean_X1 <- ald_trial$value[ald_trial$statistic == "mean" & ald_trial$variable == "X1"] +mean_X2 <- ald_trial$value[ald_trial$statistic == "mean" & ald_trial$variable == "X2"] + +d_AC_true <- b_trt + b_EM * (mean_X1 + mean_X2) ``` ```{r echo=FALSE} @@ -690,7 +734,8 @@ d_AC_true <- b_trt + b_EM * (ald_trial$mean.X1 + ald_trial$mean.X2) # d_C_true - d_A_true ``` -The naive approach is to just convert directly from one population to another, ignoring the imbalance in effect modifiers. +The naive approach is to just convert directly from one population to +another, ignoring the imbalance in effect modifiers. ```{r} d_AC_naive <- @@ -707,33 +752,43 @@ d_AC_naive <- #### $AB$ effect in $BC$ population -This is the indirect effect. The true $AB$ effect in the $BC$ population is $\beta_t^{AC} - \beta_t^{BC}$. +This is the indirect effect. The true $AB$ effect in the $BC$ population +is $\beta_t^{AC} - \beta_t^{BC}$. ```{r echo=FALSE} d_AB_true <- 0 ``` -Following the simulation study in Remiro et al (2020) these cancel out and the true effect is zero. +Following the simulation study in Remiro et al (2020) these cancel out +and the true effect is zero. The naive comparison calculating $AB$ effect in the $BC$ population is ```{r} +# reshape to make extraction easier +ald_out <- ald_trial %>% + filter(variable == "y" | is.na(variable)) %>% + mutate(stat_trt = paste0(statistic, "_", trt)) %>% + dplyr::select(stat_trt, value) %>% + pivot_wider(names_from = stat_trt, values_from = value) + d_BC <- - with(ald_trial, log(y.B.bar/(1-y.B.bar)) - log(y.C.bar/(1-y.C.bar))) + with(ald_out, log(mean_B/(1-mean_B)) - log(mean_C/(1-mean_C))) d_AB_naive <- d_AC_naive$d_AC - d_BC -var.d.BC <- with(ald_trial, 1/y.B.sum + 1/(N.B - y.B.sum) + 1/y.C.sum + 1/(N.C - y.C.sum)) +var.d.BC <- with(ald_out, 1/sum_B + 1/(N_B - sum_B) + 1/sum_C + 1/(N_C - sum_C)) var.d.AB.naive <- d_AC_naive$var_AC + var.d.BC ``` Of course, the $BC$ contrast is calculated directly. - ## Results -We now combine all outputs and present in plots and tables. For a log-odds ratio a table of all contrasts and methods in the $BC$ population is given below. +We now combine all outputs and present in plots and tables. For a +log-odds ratio a table of all contrasts and methods in the $BC$ +population is given below. ```{r echo=FALSE} res_tab <- @@ -761,9 +816,11 @@ res_tab_var <- knitr::kable(res_tab) ``` -We can see that the different corresponds reasonably well with one another. +We can see that the different corresponds reasonably well with one +another. -Next, let us look at the results on the log relative risk scale. First, the true values are calculated as +Next, let us look at the results on the log relative risk scale. First, +the true values are calculated as ```{r eval=FALSE} d_AB_true_lrr <- 0 @@ -801,7 +858,10 @@ knitr::kable(res_tab_lrr) #### Plots -The same output can be presented in forest plots is as follows. Each horizontal bar represent a different method and the facets group these by treatment comparison for the $BC$ population. The log-odds ratio and log risk ratio plot are given below. +The same output can be presented in forest plots is as follows. Each +horizontal bar represent a different method and the facets group these +by treatment comparison for the $BC$ population. The log-odds ratio and +log risk ratio plot are given below. ```{r forest-lor, fig.width=8, fig.height=6, warning=FALSE, message=FALSE, echo=FALSE} library(ggplot2) @@ -836,8 +896,6 @@ ggplot(aes(x = Estimate, y = id, col = type), data = plotdat) + ``` ```{r forest-rr, fig.width=8, fig.height=6, warning=FALSE, message=FALSE, echo=FALSE} -library(ggplot2) - var_dat <- t(res_tab_var_lrr) |> as.data.frame() |> @@ -866,4 +924,3 @@ ggplot(aes(x = Estimate, y = id, col = type), data = plotdat) + scale_y_reverse(name = "Comparison in BC population", breaks = NULL, expand = c(0, 0.6)) ``` - From fb319f249b8f9249d62bba0d1944a149c46ae1f4 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Mon, 19 May 2025 11:41:58 +0100 Subject: [PATCH 16/17] count data example vignette seeming to work * need to add compute_mean and _var version of functions --- R/calculate_ate.R | 100 +++++++- vignettes/Binary_data_example.Rmd | 10 +- vignettes/Continuous_data_example.Rmd | 327 +++++++++++-------------- vignettes/Count_data_example.Rmd | 328 +++++++++++++------------- 4 files changed, 414 insertions(+), 351 deletions(-) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index a82e0f8..e60e9ef 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -68,6 +68,9 @@ calculate_trial_variance <- function(ald, tid, effect, family) { } else if (family == "gaussian") { return( calculate_trial_variance_continuous(ald, tid, effect)) + } else if (family == "poisson") { + return( + calculate_trial_variance_count(ald, tid, effect)) } stop("family not recognised.") @@ -140,6 +143,49 @@ calculate_trial_variance_continuous <- function(ald, tid, effect) { effect_functions[[effect]]() } +#' @export +calculate_trial_variance_count <- function(ald, tid, effect) { + + ybar <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "mean")$value + + ysd <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sd")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value + + effect_functions <- list( + + # Variance of log(rate) ~= 1 / (N * ybar) under Poisson assumptions + log_relative_risk = function() 1 / (N * ybar), + + # Variance of rate difference = variance of mean = ybar / N + rate_difference = function() ybar / N, + + # Signal-to-noise measure's approximate variance (can vary) + delta_z = function() { + # Var of sqrt(lambda) ≈ 1 / (4 * N * lambda) via delta method + 1 / (4 * N * ybar) + } + ) + + if (!effect %in% names(effect_functions)) { + stop(paste0("Unsupported effect function. Choose from ", + names(effect_functions))) + } + + effect_functions[[effect]]() +} + #' @export calculate_trial_mean <- function(ald, tid, effect, family) { @@ -149,6 +195,9 @@ calculate_trial_mean <- function(ald, tid, effect, family) { } else if (family == "gaussian") { return( calculate_trial_mean_continuous(ald, tid, effect)) + } else if (family == "poisson") { + return( + calculate_trial_mean_count(ald, tid, effect)) } stop("family not recognised.") @@ -211,8 +260,12 @@ calculate_trial_mean_continuous <- function(ald, tid, effect) { message("log mean used\n") log(ybar) }, - risk_difference = function() ybar, - delta_z = function() ybar / ysd, + risk_difference = function() { + ybar + }, + delta_z = function() { + ybar / ysd + }, log_relative_risk = function() { message("log mean used\n") log(ybar) @@ -228,6 +281,49 @@ calculate_trial_mean_continuous <- function(ald, tid, effect) { effect_fns[[effect]]() } +#' @export +calculate_trial_mean_count <- function(ald, tid, effect) { + + ybar <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "mean")$value + + ysd <- dplyr::filter( + ald, + variable == "y", + trt == tid, + statistic == "sd")$value + + N <- dplyr::filter( + ald, + trt == tid, + statistic == "N")$value + + effect_fns <- list( + log_relative_risk = function() { + message("log rate used\n") + log(ybar) + }, + rate_difference = function() { + ybar + }, + delta_z = function() { + # signal-to-noise under Poisson + ybar / sqrt(ybar) + } + # log_relative_risk_rare_events intentionally unsupported + ) + + if (!effect %in% names(effect_fns)) { + stop(paste0("Unsupported link function. Choose from ", + names(effect_fns))) + } + + effect_fns[[effect]]() +} + #' Get treatment effect scale corresponding to a link function #' diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index dea635c..3db45ca 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -151,7 +151,7 @@ The simulation input parameters are given below. | `b_0` | Baseline intercept | -0.6 | We shall use the `gen_data()` function available with the -[simcovariates](https://github.com/n8thangreen/simcovariates) package. +[simcovariates](https://github.com/n8thangreen/simcovariates) package on GitHub. ```{r, warning=FALSE, message=FALSE} library(dplyr) @@ -211,7 +211,7 @@ cov.X <- group_by(variable) %>% summarise( mean = mean(value), - sd = sd(value), + sd = sd(value) ) %>% pivot_longer(cols = c("mean", "sd"), names_to = "statistic", values_to = "value") %>% ungroup() |> @@ -227,7 +227,7 @@ summary.y <- summarise( mean = mean(value), sd = sd(value), - sum = sum(value), + sum = sum(value) ) %>% pivot_longer(cols = c("mean", "sd", "sum"), names_to = "statistic", values_to = "value") %>% @@ -251,7 +251,7 @@ the following. #### `ipd_trial`: Individual patient data - `X*`: Patient measurements -- `trt`: Treatment ID (integer) +- `trt`: Treatment label (factor) - `y`: Indicator of whether event was observed (two level factor) #### `ald_trial`: Aggregate-level data @@ -272,7 +272,7 @@ head(ipd_trial) There are 4 correlated continuous covariates generated per subject, simulated from a multivariate normal distribution. Treatment `trt` takes -either new treatment *A* or standard of care or status quo *C*. The ITC +either new treatment *A* or standard of care / status quo *C*. The ITC is 'anchored' via *C*, the common treatment. ```{r} diff --git a/vignettes/Continuous_data_example.Rmd b/vignettes/Continuous_data_example.Rmd index 75664f1..99e3d17 100644 --- a/vignettes/Continuous_data_example.Rmd +++ b/vignettes/Continuous_data_example.Rmd @@ -18,8 +18,12 @@ knitr::opts_chunk$set( ) ``` -##TODO +## Introduction +This is the vignette for performing population adjustment methods with continuous data, in order to compare marginal +treatment effects when there are cross-trial differences in effect modifiers and limited patient-level data. +We will demonstrate how to apply MAIC, STC, G-computation with ML, G-computation with Bayesian inference and multiple imputation marginalisation. +The document structure follow the binary data example vignette which should be referred to for more details. ## Example analysis @@ -30,30 +34,17 @@ library(boot) # non-parametric bootstrap in MAIC and ML G-computation library(copula) # simulating BC covariates from Gaussian copula library(rstanarm) # fit outcome regression, draw outcomes in Bayesian G-computation library(outstandR) +library(tidyr) library(simcovariates) ``` ### Data -Next, we load the data to use in the analysis. The data comes from a -simulation study in Remiro‐Azócar A, Heath A, Baio G (2020). We consider -binary outcomes using the log-odds ratio as the measure of effect. The -binary outcome may be response to treatment or the occurrence of an -adverse event. For trials *AC* and *BC*, outcome $y_n$ for subject $n$ -is simulated from a Bernoulli distribution with probabilities of success -generated from logistic regression. +We first simulate both the IPD and ALD data. See the binary data example vignette for more details on how this is implemented. +The difference with that example is that we change the `family` argument in `gen_data()` to `gaussian(link = "identity")`, corresponding to the continuous data case. +The `gen_data()` function is available in the [simcovariates](https://github.com/n8thangreen/simcovariates) package on GitHub. -For the *BC* trial, the individual-level covariates and outcomes are -aggregated to obtain summaries. The continuous covariates are summarized -as means and standard deviations, which would be available to the -analyst in the published study in a table of baseline characteristics in -the RCT publication. The binary outcomes are summarized in an overall -event table. Typically, the published study only provides aggregate -information to the analyst. - -Use the `gen_data()` function available in the [simcovariates](https://github.com/n8thangreen/simcovariates) package. - -```{r} +```{r, warning=FALSE, message=FALSE} library(dplyr) library(MASS) @@ -80,52 +71,78 @@ ipd_trial <- gen_data(N, b_trt, b_X, b_EM, b_0, ipd_trial$trt <- factor(ipd_trial$trt, labels = c("C", "A")) ``` -Similarly, for the aggregate data but with the additional summarise step. +Similarly, for the aggregate data but with the additional summarise step (see binary data example vignette for code). -```{r generate-ald-data} +```{r generate-ald-data, echo=FALSE, warning=FALSE, message=FALSE} BC.IPD <- gen_data(N, b_trt, b_X, b_EM, b_0, meanX_BC, sdX, meanX_EM_BC, sdX_EM, corX, allocation, family = gaussian(link = "identity")) -cov.X <- BC.IPD %>% - summarise(across(starts_with("X"), - list(mean = mean, sd = sd), - .names = "{fn}.{col}")) - -out.B <- dplyr::filter(BC.IPD, trt == 1) %>% - summarise(y.B.sum = sum(y), - y.B.bar = mean(y), - y.B.sd = sd(y), - N.B = n()) - -out.C <- dplyr::filter(BC.IPD, trt == 0) %>% - summarise(y.C.sum = sum(y), - y.C.bar = mean(y), - y.C.sd = sd(y), - N.C = n()) - -ald_trial <- cbind.data.frame(cov.X, out.B, out.C) +BC.IPD$trt <- factor(BC.IPD$trt, labels = c("C", "B")) + +# covariate summary statistics +# assume same between treatments +cov.X <- + BC.IPD %>% + as.data.frame() |> + dplyr::select(X1, X2, X3, X4, trt) %>% + pivot_longer(cols = starts_with("X"), names_to = "variable", values_to = "value") %>% + group_by(variable) %>% + summarise( + mean = mean(value), + sd = sd(value) + ) %>% + pivot_longer(cols = c("mean", "sd"), names_to = "statistic", values_to = "value") %>% + ungroup() |> + mutate(trt = NA) + +# outcome +summary.y <- + BC.IPD |> + as.data.frame() |> + dplyr::select(y, trt) %>% + pivot_longer(cols = "y", names_to = "variable", values_to = "value") %>% + group_by(variable, trt) %>% + summarise( + mean = mean(value), + sd = sd(value), + sum = sum(value), + ) %>% + pivot_longer(cols = c("mean", "sd", "sum"), + names_to = "statistic", values_to = "value") %>% + ungroup() + +# sample sizes +summary.N <- + BC.IPD |> + group_by(trt) |> + count(name = "N") |> + pivot_longer(cols = "N", names_to = "statistic", values_to = "value") |> + mutate(variable = NA_character_) |> + dplyr::select(variable, statistic, value, trt) + +ald_trial <- rbind.data.frame(cov.X, summary.y, summary.N) ``` -This general format of data sets consist of the following. +This general format of the data sets are in a 'long' style consisting of the following. #### `ipd_trial`: Individual patient data -- `X*`: patient measurements -- `trt`: treatment ID (integer) -- `y`: continuous outcome measure +- `X*`: Patient measurements +- `trt`: Treatment label (factor) +- `y`: Continuous numeric #### `ald_trial`: Aggregate-level data -- `mean.X*`: mean patient measurement -- `sd.X*`: standard deviation of patient measurement -- `mean.y`: -- `sd.y`: - -Note that the wildcard `*` here is usually an integer from 1 or the -trial identifier *B*, *C*. +- `variable`: Covariate name. In the case of treatment arm sample size + this is `NA` +- `statistic`: Summary statistic name from mean, standard deviation or + sum +- `value`: Numerical value of summary statistic +- `trt`: Treatment label. Because we assume a common covariate + distribution between treatment arms this is `NA` Our data look like the following. @@ -134,31 +151,20 @@ head(ipd_trial) ``` There are 4 correlated continuous covariates generated per subject, -simulated from a multivariate normal distribution. +simulated from a multivariate normal distribution. Treatment `trt` takes +either new treatment *A* or standard of care / status quo *C*. The ITC +is 'anchored' via *C*, the common treatment. ```{r} ald_trial ``` In this case, we have 4 covariate mean and standard deviation values; -and the event total, average and sample size for each treatment *B*, and +and the total, average and sample size for each treatment *B* and *C*. -### Output statistics - -We will implement for MAIC, STC, and G-computation methods to obtain the -*marginal variance*, defined as - -$$ -$$ - -and the *marginal treatment effect*, defined as the log-odds ratio, - -$$ -$$ - -where $\bar{C}$ is the compliment of $C$ so e.g. -$n_{\bar{C}} = N_C - n_c$. +In the following we will implement for MAIC, STC, and G-computation methods to obtain the +*marginal variance* and the *marginal treatment effect*. ## Model fitting in R @@ -173,28 +179,17 @@ A `strategy` argument of `outstandR` takes functions called particular method required, e.g. `strategy_maic()` for MAIC. Each specific example is provided below. -### MAIC - -Using the individual level data for *AC* firstly we perform -non-parametric bootstrap of the `maic.boot` function with `R = 1000` -replicates. This function fits treatment coefficient for the marginal -effect for *A* vs *C*. The returned value is an object of class `boot` -from the `{boot}` package. We then calculate the bootstrap mean and -variance in the wrapper function `maic_boot_stats`. - -The formula used in this model is - -$$ -y = X_3 + X_4 + \beta_t X_1 + \beta_t X_2 -$$ - -which corresponds to the following `R` `formula` object passed as an -argument to the strategy function. +The formula used in this model, passed as an +argument to the strategy function is ```{r} lin_form <- as.formula("y ~ X3 + X4 + trt*X1 + trt*X2") ``` +### MAIC + +As mentioned above, pass the model specific strategy function to the main `outstandR()` function, in this case use `strategy_maic()`. + ```{r outstandR_maic} outstandR_maic <- outstandR(ipd_trial, ald_trial, @@ -209,37 +204,12 @@ The returned object is of class `outstandR`. outstandR_maic ``` -We see that this is a list object with 3 parts, each containing -statistics between each pair of treatments. These are the mean -contrasts, variances and confidence intervals (CI), respectively. The -default CI is for 95% but can be altered in `outstandR` with the `CI` -argument. -### STC +### Simulated Treatment Comparison (STC) STC is the conventional outcome regression method. It involves fitting a -regression model of outcome on treatment and covariates to the IPD. IPD -effect modifiers are centred at the mean *BC* values. - -$$ -g(\mu_n) = \beta_0 + (\boldsymbol{x}_n - \boldsymbol{\theta}) \beta_1 + (\beta_z + (\boldsymbol{x_n^{EM}} - \boldsymbol{\theta^{EM}}) \boldsymbol{\beta_2}) \; \mbox{I}(z_n=1) -$$ - -where $\beta_0$ is the intercept, $\beta_1$ are the covariate -coefficients, $\beta_z$ and $\beta_2$ are the effect modifier -coefficients, $z_n$ are the indicator variables of effect alternative -treatment. $g(\cdot)$ is the link function e.g. $\log$. - -As already mentioned, running the STC analysis is almost identical to -the previous analysis but we now use the `strategy_stc()` strategy -function instead and a formula with centered covariates. - -$$ -y = X_3 + X_4 + \beta_t(X_1 - \bar{X_1}) + \beta_t(X_2 - \bar{X_2}) -$$ - -However, `outstandR()` knows how to handle this so we can simply pass -the same (uncentred) formula as before. +regression model of outcome on treatment and covariates to the IPD. Simply pass +the same as formula as before with the `strategy_stc()` strategy function. ```{r outstandR_stc} outstandR_stc <- @@ -250,52 +220,22 @@ outstandR_stc <- outstandR_stc ``` -For the last two approaches, we perform G-computation firstly with a -frequentist MLE approach and then a Bayesian approach. ### Parametric G-computation with maximum-likelihood estimation G-computation marginalizes the conditional estimates by separating the regression modelling from the estimation of the marginal treatment -effect for *A* versus *C*. First, a regression model of the observed -outcome $y$ on the covariates $x$ and treatment $z$ is fitted to the -*AC* IPD: - -$$ -g(\mu_n) = \beta_0 + \boldsymbol{x}_n \boldsymbol{\beta_1} + (\beta_z + \boldsymbol{x_n^{EM}} \boldsymbol{\beta_2}) \; \mbox{I}(z_n = 1) -$$ - -In the context of G-computation, this regression model is often called -the “Q-model.” Having fitted the Q-model, the regression coefficients -are treated as nuisance parameters. The parameters are applied to the -simulated covariates $x*$ to predict hypothetical outcomes for each -subject under both possible treatments. Namely, a pair of predicted -outcomes, also called potential outcomes, under *A* and under *C*, is -generated for each subject. - -By plugging treatment *C* into the regression fit for every simulated -observation, we predict the marginal outcome mean in the hypothetical -scenario in which all units are under treatment *C*: - -$$ -\hat{\mu}_0 = \int_{x^*} g^{-1} (\hat{\beta}_0 + x^* \hat{\beta}_1 ) p(x^*) \; \text{d}x^* -$$ - -To estimate the marginal or population-average treatment effect for *A* -versus *C* in the linear predictor scale, one back-transforms to this -scale the average predictions, taken over all subjects on the natural -outcome scale, and calculates the difference between the average linear -predictions: - -$$ -\hat{\Delta}^{(2)}_{10} = g(\hat{\mu}_1) - g(\hat{\mu}_0) -$$ +effect for *A* versus *C*. +Pass the `strategy_gcomp_ml()` strategy function. + ```{r outstandR_gcomp_ml} outstandR_gcomp_ml <- outstandR(ipd_trial, ald_trial, - strategy = strategy_gcomp_ml(formula = lin_form, - family = gaussian(link = "identity"))) + strategy = strategy_gcomp_ml( + formula = lin_form, + family = gaussian(link = "identity"))) + outstandR_gcomp_ml ``` @@ -307,32 +247,7 @@ The Bayesian approach also marginalizes, integrates or standardizes over the joint posterior distribution of the conditional nuisance parameters of the outcome regression, as well as the joint covariate distribution. -Draw a vector of size $N^*$ of predicted outcomes $y^*_z$ under each set -intervention $z^* \in \{0, 1\}$ from its posterior predictive -distribution under the specific treatment. This is defined as -$p(y^*_{z^*} \mid \mathcal{D}_{AC}) = \int_{\beta} p(y^*_{z^*} \mid \beta) p(\beta \mid \mathcal{D}_{AC}) d\beta$ -where $p(\beta \mid \mathcal{D}_{AC})$ is the posterior distribution of -the outcome regression coefficients $\beta$, which encode the -predictor-outcome relationships observed in the *AC* trial IPD. This is -given by: - -$$ -p(y^*_{^z*} \mid \mathcal{D}_{AC}) = \int_{x^*} p(y^* \mid z^*, x^*, \mathcal{D}_{AC}) p(x^* \mid \mathcal{D}_{AC})\; \text{d}x^* -$$ - -$$ -= \int_{x^*} \int_{\beta} p(y^* \mid z^*, x^*, \beta) p(x^* \mid \beta) p(\beta \mid \mathcal{D}_{AC})\; d\beta \; \text{d}x^* -$$ - -In practice, the integrals above can be approximated numerically, using -full Bayesian estimation via Markov chain Monte Carlo (MCMC) sampling. - -The average, variance and interval estimates of the marginal treatment -effect can be derived empirically from draws of the posterior density. - -We can draw a vector of size $N^*$ of predicted outcomes $y^*_z$ under -each set intervention $z^*$ from its posterior predictive distribution -under the specific treatment. +Pass the `strategy_gcomp_stan()` strategy function. ```{r outstandR_gcomp_stan, eval=FALSE} outstandR_gcomp_stan <- @@ -357,11 +272,7 @@ outstandR_gcomp_stan ### Multiple imputation marginalisation -ref - -$$ -equation here -$$ +Finally, the strategy function to pass to `outstandR()` for multiple imputation marginalisation is `strategy_mim()`, ```{r outstandR_mim, eval=FALSE} outstandR_mim <- @@ -388,14 +299,60 @@ outstandR_mim Combine all outputs for relative effects table of all contrasts and methods. -```{r} -knitr::kable( +```{r table-res, echo=FALSE} +res_tab <- data.frame( + # d_true = c(d_AB_true, d_AC_true, d_BC), + # d_naive = c(d_AB_naive, d_AC_naive$d_AC, d_BC), `MAIC` = unlist(outstandR_maic$contrasts$means), `STC` = unlist(outstandR_stc$contrasts$means), `Gcomp ML` = unlist(outstandR_gcomp_ml$contrasts$means), `Gcomp Bayes` = unlist(outstandR_gcomp_stan$contrasts$means), - `MIM` = unlist(outstandR_mim$contrasts$means)) - |> - round(2)) + `MIM` = unlist(outstandR_mim$contrasts$means)) |> + round(2) + +res_tab_var <- + data.frame( + # d_true = c(NA, NA, NA), + # d_naive = c(var.d.AB.naive, d_AC_naive$var_AC, var.d.BC), + `MAIC` = unlist(outstandR_maic$contrasts$variances), + `STC` = unlist(outstandR_stc$contrasts$variances), + `Gcomp ML` = unlist(outstandR_gcomp_ml$contrasts$variances), + `Gcomp Bayes` = unlist(outstandR_gcomp_stan$contrasts$variances), + `MIM` = unlist(outstandR_mim$contrasts$variances)) |> + round(2) + +knitr::kable(res_tab) +``` + +```{r forest-res, fig.width=8, fig.height=6, warning=FALSE, message=FALSE, echo=FALSE} +library(ggplot2) + +var_dat <- + t(res_tab_var) |> + as.data.frame() |> + tibble::rownames_to_column("type") |> + reshape2::melt(variable.name = "Comparison", + value.name = "var") + +plotdat <- + t(res_tab) |> + as.data.frame() |> + tibble::rownames_to_column("type") |> + reshape2::melt(variable.name = "Comparison", + value.name = "Estimate") |> + mutate(id = 1:n(), + type = as.factor(type)) |> + merge(var_dat) |> + mutate(lo = Estimate + qnorm(0.025) * sqrt(var), + hi = Estimate + qnorm(0.975) * sqrt(var)) + +ggplot(aes(x = Estimate, y = id, col = type), data = plotdat) + + geom_vline(xintercept = 0, lty = 2) + + geom_point(size = 2) + + geom_segment(aes(y = id, yend = id, x = lo, xend = hi), na.rm = TRUE) + + xlab("Estimate (Log RR)") + + facet_grid(Comparison~., switch = "y", scales = "free_y", space = "free_y") + + scale_y_reverse(name = "Comparison in BC population", + breaks = NULL, expand = c(0, 0.6)) ``` diff --git a/vignettes/Count_data_example.Rmd b/vignettes/Count_data_example.Rmd index 922d0e6..ee5f5e7 100644 --- a/vignettes/Count_data_example.Rmd +++ b/vignettes/Count_data_example.Rmd @@ -14,13 +14,18 @@ vignette: > ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, - eval = FALSE, ##TODO: + eval = TRUE, comment = "#>" ) ``` ## Introduction +This is the vignette for performing population adjustment methods with count data, in order to compare marginal +treatment effects when there are cross-trial differences in effect modifiers and limited patient-level data. +We will demonstrate how to apply MAIC, STC, G-computation with ML, G-computation with Bayesian inference and multiple imputation marginalisation. +The document structure follow the binary data example vignette which should be referred to for more details. + ## Example analysis First, let us load necessary packages. @@ -30,19 +35,20 @@ library(boot) # non-parametric bootstrap in MAIC and ML G-computation library(copula) # simulating BC covariates from Gaussian copula library(rstanarm) # fit outcome regression, draw outcomes in Bayesian G-computation library(outstandR) +library(tidyr) library(simcovariates) ``` ### Data -First, use the `gen_data()` function available in the [simcovariates](https://github.com/n8thangreen/simcovariates) package. +We first simulate both the IPD and ALD count data. See the binary data example vignette for more details on how this is implemented. +The difference with that example is that we change the `family` argument in `gen_data()` to `poisson(link = "log")`, corresponding to the count data case. +The `gen_data()` function is available in the [simcovariates](https://github.com/n8thangreen/simcovariates) package on GitHub. -```{r warning=FALSE, message=FALSE} +```{r, warning=FALSE, message=FALSE} library(dplyr) library(MASS) -``` -```{r} N <- 200 allocation <- 2/3 # active treatment vs. placebo allocation ratio (2:1) b_trt <- log(0.17) # conditional effect of active treatment vs. common comparator @@ -66,55 +72,100 @@ ipd_trial <- gen_data(N, b_trt, b_X, b_EM, b_0, ipd_trial$trt <- factor(ipd_trial$trt, labels = c("C", "A")) ``` -Similarly, for the aggregate data but with the additional summarise step. +Similarly, for the aggregate data but with the additional summarise step (see binary data example vignette for code). -```{r generate-ald-data} +```{r generate-ald-data, echo=FALSE, warning=FALSE, message=FALSE} BC.IPD <- gen_data(N, b_trt, b_X, b_EM, b_0, meanX_BC, sdX, meanX_EM_BC, sdX_EM, corX, allocation, family = poisson(link = "log")) -cov.X <- BC.IPD %>% - summarise(across(starts_with("X"), - list(mean = mean, sd = sd), - .names = "{fn}.{col}")) - -out.C <- dplyr::filter(BC.IPD, trt == 1) %>% - summarise(y.B.sum = sum(y), - y.B.bar = mean(y), - N.B = n()) - -out.B <- dplyr::filter(BC.IPD, trt == 0) %>% - summarise(y.C.sum = sum(y), - y.C.bar = mean(y), - N.C = n()) +BC.IPD$trt <- factor(BC.IPD$trt, labels = c("C", "B")) + +# covariate summary statistics +# assume same between treatments +cov.X <- + BC.IPD %>% + as.data.frame() |> + dplyr::select(X1, X2, X3, X4, trt) %>% + pivot_longer(cols = starts_with("X"), names_to = "variable", values_to = "value") %>% + group_by(variable) %>% + summarise( + mean = mean(value), + sd = sd(value) + ) %>% + pivot_longer(cols = c("mean", "sd"), names_to = "statistic", values_to = "value") %>% + ungroup() |> + mutate(trt = NA) + +# outcome +summary.y <- + BC.IPD |> + as.data.frame() |> + dplyr::select(y, trt) %>% + pivot_longer(cols = "y", names_to = "variable", values_to = "value") %>% + group_by(variable, trt) %>% + summarise( + mean = mean(value), + sd = sd(value), + sum = sum(value), + ) %>% + pivot_longer(cols = c("mean", "sd", "sum"), + names_to = "statistic", values_to = "value") %>% + ungroup() + +# sample sizes +summary.N <- + BC.IPD |> + group_by(trt) |> + count(name = "N") |> + pivot_longer(cols = "N", names_to = "statistic", values_to = "value") |> + mutate(variable = NA_character_) |> + dplyr::select(variable, statistic, value, trt) + +ald_trial <- rbind.data.frame(cov.X, summary.y, summary.N) +``` -ald_trial <- cbind.data.frame(cov.X, out.C, out.B) +This general format of the data sets are in a 'long' style consisting of the following. -# By definition, the true log-OR relative effect in the AC population between AC is `r b_trt`. Between BC is `r b_trt` and between AB is `r b_trt - b_trt`. -# A naive indirect comparison, ignoring the presence of effect modifiers, would calculate the C vs B effect in the AC population as -# `b_trt - b_trt`. -``` +#### `ipd_trial`: Individual patient data +- `X*`: Patient measurements +- `trt`: Treatment label (factor) +- `y`: Counts +#### `ald_trial`: Aggregate-level data +- `variable`: Covariate name. In the case of treatment arm sample size + this is `NA` +- `statistic`: Summary statistic name from mean, standard deviation or + sum +- `value`: Numerical value of summary statistic +- `trt`: Treatment label. Because we assume a common covariate + distribution between treatment arms this is `NA` -### Output statistics +Our data look like the following. -We will implement for MAIC, STC, and G-computation methods to obtain the -*marginal variance*, defined as +```{r} +head(ipd_trial) +``` -$$ -$$ +There are 4 correlated continuous covariates generated per subject, +simulated from a multivariate normal distribution. Treatment `trt` takes +either new treatment *A* or standard of care / status quo *C*. The ITC +is 'anchored' via *C*, the common treatment. -and the *marginal treatment effect*, defined as the log-odds ratio, +```{r} +ald_trial +``` -$$ -$$ +In this case, we have 4 covariate mean and standard deviation values; +and the total, average and sample size for each treatment *B* and +*C*. -where $\bar{C}$ is the compliment of $C$ so e.g. -$n_{\bar{C}} = N_C - n_c$. +In the following we will implement for MAIC, STC, and G-computation methods to obtain the +*marginal variance* and the *marginal treatment effect*. ## Model fitting in R @@ -129,28 +180,17 @@ A `strategy` argument of `outstandR` takes functions called particular method required, e.g. `strategy_maic()` for MAIC. Each specific example is provided below. -### MAIC - -Using the individual level data for *AC* firstly we perform -non-parametric bootstrap of the `maic.boot` function with `R = 1000` -replicates. This function fits treatment coefficient for the marginal -effect for *A* vs *C*. The returned value is an object of class `boot` -from the `{boot}` package. We then calculate the bootstrap mean and -variance in the wrapper function `maic_boot_stats()`. - -The formula used in this model is - -$$ -y = X_3 + X_4 + \beta_t X_1 + \beta_t X_2 -$$ - -which corresponds to the following `R` `formula` object passed as an -argument to the strategy function. +The formula used in this model, passed as an +argument to the strategy function is ```{r} lin_form <- as.formula("y ~ X3 + X4 + trt*X1 + trt*X2") ``` +### MAIC + +As mentioned above, pass the model specific strategy function to the main `outstandR()` function, in this case use `strategy_maic()`. + ```{r outstandR_maic} outstandR_maic <- outstandR(ipd_trial, ald_trial, @@ -165,37 +205,12 @@ The returned object is of class `outstandR`. outstandR_maic ``` -We see that this is a list object with 3 parts, each containing -statistics between each pair of treatments. These are the mean -contrasts, variances and confidence intervals (CI), respectively. The -default CI is for 95% but can be altered in `outstandR` with the `CI` -argument. -### STC +### Simulated Treatment Comparison (STC) STC is the conventional outcome regression method. It involves fitting a -regression model of outcome on treatment and covariates to the IPD. IPD -effect modifiers are centred at the mean *BC* values. - -$$ -g(\mu_n) = \beta_0 + (\boldsymbol{x}_n - \boldsymbol{\theta}) \beta_1 + (\beta_z + (\boldsymbol{x_n^{EM}} - \boldsymbol{\theta^{EM}}) \boldsymbol{\beta_2}) \; \mbox{I}(z_n=1) -$$ - -where $\beta_0$ is the intercept, $\beta_1$ are the covariate -coefficients, $\beta_z$ and $\beta_2$ are the effect modifier -coefficients, $z_n$ are the indicator variables of effect alternative -treatment. $g(\cdot)$ is the link function e.g. $\log$. - -As already mentioned, running the STC analysis is almost identical to -the previous analysis but we now use the `strategy_stc()` strategy -function instead and a formula with centered covariates. - -$$ -y = X_3 + X_4 + \beta_t(X_1 - \bar{X_1}) + \beta_t(X_2 - \bar{X_2}) -$$ - -However, `outstandR()` knows how to handle this so we can simply pass -the same (uncentred) formula as before. +regression model of outcome on treatment and covariates to the IPD. Simply pass +the same as formula as before with the `strategy_stc()` strategy function. ```{r outstandR_stc} outstandR_stc <- @@ -203,58 +218,24 @@ outstandR_stc <- strategy = strategy_stc( formula = lin_form, family = poisson(link = "log"))) - outstandR_stc ``` -For the last two approaches, we perform G-computation firstly with a -frequentist MLE approach and then a Bayesian approach. ### Parametric G-computation with maximum-likelihood estimation G-computation marginalizes the conditional estimates by separating the regression modelling from the estimation of the marginal treatment -effect for *A* versus *C*. First, a regression model of the observed -outcome $y$ on the covariates $x$ and treatment $z$ is fitted to the -*AC* IPD: - -$$ -g(\mu_n) = \beta_0 + \boldsymbol{x}_n \boldsymbol{\beta_1} + (\beta_z + \boldsymbol{x_n^{EM}} \boldsymbol{\beta_2}) \; \mbox{I}(z_n = 1) -$$ - -In the context of G-computation, this regression model is often called -the “Q-model.” Having fitted the Q-model, the regression coefficients -are treated as nuisance parameters. The parameters are applied to the -simulated covariates $x*$ to predict hypothetical outcomes for each -subject under both possible treatments. Namely, a pair of predicted -outcomes, also called potential outcomes, under *A* and under *C*, is -generated for each subject. - -By plugging treatment *C* into the regression fit for every simulated -observation, we predict the marginal outcome mean in the hypothetical -scenario in which all units are under treatment *C*: - -$$ -\hat{\mu}_0 = \int_{x^*} g^{-1} (\hat{\beta}_0 + x^* \hat{\beta}_1 ) p(x^*) \; \text{d}x^* -$$ - -To estimate the marginal or population-average treatment effect for *A* -versus *C* in the linear predictor scale, one back-transforms to this -scale the average predictions, taken over all subjects on the natural -outcome scale, and calculates the difference between the average linear -predictions: - -$$ -\hat{\Delta}^{(2)}_{10} = g(\hat{\mu}_1) - g(\hat{\mu}_0) -$$ - -```{r outstandR_gcomp_ml} +effect for *A* versus *C*. +Pass the `strategy_gcomp_ml()` strategy function. + + +```{r outstandR_gcomp_ml, message=FALSE, warning=FALSE} outstandR_gcomp_ml <- outstandR(ipd_trial, ald_trial, strategy = strategy_gcomp_ml( formula = lin_form, family = poisson(link = "log"))) - outstandR_gcomp_ml ``` @@ -266,34 +247,9 @@ The Bayesian approach also marginalizes, integrates or standardizes over the joint posterior distribution of the conditional nuisance parameters of the outcome regression, as well as the joint covariate distribution. -Draw a vector of size $N^*$ of predicted outcomes $y^*_z$ under each set -intervention $z^* \in \{0, 1\}$ from its posterior predictive -distribution under the specific treatment. This is defined as -$p(y^*_{z^*} \mid \mathcal{D}_{AC}) = \int_{\beta} p(y^*_{z^*} \mid \beta) p(\beta \mid \mathcal{D}_{AC}) d\beta$ -where $p(\beta \mid \mathcal{D}_{AC})$ is the posterior distribution of -the outcome regression coefficients $\beta$, which encode the -predictor-outcome relationships observed in the *AC* trial IPD. This is -given by: - -$$ -p(y^*_{^z*} \mid \mathcal{D}_{AC}) = \int_{x^*} p(y^* \mid z^*, x^*, \mathcal{D}_{AC}) p(x^* \mid \mathcal{D}_{AC})\; \text{d}x^* -$$ - -$$ -= \int_{x^*} \int_{\beta} p(y^* \mid z^*, x^*, \beta) p(x^* \mid \beta) p(\beta \mid \mathcal{D}_{AC})\; d\beta \; \text{d}x^* -$$ - -In practice, the integrals above can be approximated numerically, using -full Bayesian estimation via Markov chain Monte Carlo (MCMC) sampling. - -The average, variance and interval estimates of the marginal treatment -effect can be derived empirically from draws of the posterior density. +Pass the `strategy_gcomp_stan()` strategy function. -We can draw a vector of size $N^*$ of predicted outcomes $y^*_z$ under -each set intervention $z^*$ from its posterior predictive distribution -under the specific treatment. - -```{r outstandR_gcomp_stan, eval=FALSE} +```{r outstandR_gcomp_stan, eval=FALSE, message=FALSE, warning=FALSE} outstandR_gcomp_stan <- outstandR(ipd_trial, ald_trial, strategy = strategy_gcomp_stan( @@ -301,7 +257,7 @@ outstandR_gcomp_stan <- family = poisson(link = "log"))) ``` -```{r outstandR_gcomp_stan_eval, echo=FALSE} +```{r outstandR_gcomp_stan_eval, echo=FALSE, message=FALSE, warning=FALSE} xx <- capture.output( outstandR_gcomp_stan <- outstandR(ipd_trial, ald_trial, @@ -316,33 +272,87 @@ outstandR_gcomp_stan ### Multiple imputation marginalisation -ref - -$$ -equation here -$$ +Finally, the strategy function to pass to `outstandR()` for multiple imputation marginalisation is `strategy_mim()`, -```{r outstandR_mim} +```{r outstandR_mim, eval=FALSE} outstandR_mim <- outstandR(ipd_trial, ald_trial, strategy = strategy_mim( formula = lin_form, family = poisson(link = "log"))) +``` + +```{r outstandR_mim_eval, echo=FALSE} +xx <- capture.output( + outstandR_mim <- + outstandR(ipd_trial, ald_trial, + strategy = strategy_mim( + formula = lin_form, + family = poisson(link = "log")))) +``` + +```{r} outstandR_mim ``` ### Model comparison -Combine all outputs for log-odds ratio table of all contrasts and methods. +Combine all outputs for relative effects table of all contrasts and methods. -```{r} -knitr::kable( +```{r table-res, echo=FALSE} +res_tab <- data.frame( + # d_true = c(d_AB_true, d_AC_true, d_BC), + # d_naive = c(d_AB_naive, d_AC_naive$d_AC, d_BC), `MAIC` = unlist(outstandR_maic$contrasts$means), `STC` = unlist(outstandR_stc$contrasts$means), `Gcomp ML` = unlist(outstandR_gcomp_ml$contrasts$means), `Gcomp Bayes` = unlist(outstandR_gcomp_stan$contrasts$means), - `MIM` = unlist(outstandR_mim$contrasts$means)) -) |> + `MIM` = unlist(outstandR_mim$contrasts$means)) |> round(2) + +res_tab_var <- + data.frame( + # d_true = c(NA, NA, NA), + # d_naive = c(var.d.AB.naive, d_AC_naive$var_AC, var.d.BC), + `MAIC` = unlist(outstandR_maic$contrasts$variances), + `STC` = unlist(outstandR_stc$contrasts$variances), + `Gcomp ML` = unlist(outstandR_gcomp_ml$contrasts$variances), + `Gcomp Bayes` = unlist(outstandR_gcomp_stan$contrasts$variances), + `MIM` = unlist(outstandR_mim$contrasts$variances)) |> + round(2) + +knitr::kable(res_tab) +``` + +```{r forest-res, fig.width=8, fig.height=6, warning=FALSE, message=FALSE, echo=FALSE} +library(ggplot2) + +var_dat <- + t(res_tab_var) |> + as.data.frame() |> + tibble::rownames_to_column("type") |> + reshape2::melt(variable.name = "Comparison", + value.name = "var") + +plotdat <- + t(res_tab) |> + as.data.frame() |> + tibble::rownames_to_column("type") |> + reshape2::melt(variable.name = "Comparison", + value.name = "Estimate") |> + mutate(id = 1:n(), + type = as.factor(type)) |> + merge(var_dat) |> + mutate(lo = Estimate + qnorm(0.025) * sqrt(var), + hi = Estimate + qnorm(0.975) * sqrt(var)) + +ggplot(aes(x = Estimate, y = id, col = type), data = plotdat) + + geom_vline(xintercept = 0, lty = 2) + + geom_point(size = 2) + + geom_segment(aes(y = id, yend = id, x = lo, xend = hi), na.rm = TRUE) + + xlab("Estimate (Log RR)") + + facet_grid(Comparison~., switch = "y", scales = "free_y", space = "free_y") + + scale_y_reverse(name = "Comparison in BC population", + breaks = NULL, expand = c(0, 0.6)) ``` From a2fa3b248817c6d99e337b6e45a3eae6a22ffc11 Mon Sep 17 00:00:00 2001 From: Dr Nathan Green Date: Mon, 19 May 2025 14:18:09 +0100 Subject: [PATCH 17/17] exercise qmd draft added --- NAMESPACE | 2 + R/calculate_ate.R | 41 +- R/outstandR.R | 12 +- R/validate_outstandr.R | 3 +- man/IPD_stat_factory.Rd | 2 +- man/calc_IPD_stats.Rd | 19 +- man/calc_gcomp_ml.Rd | 6 +- man/calc_gcomp_stan.Rd | 6 +- man/gcomp_ml.boot.Rd | 14 +- man/gcomp_ml_means.Rd | 20 +- man/marginal_treatment_effect.Rd | 6 - man/marginal_variance.Rd | 2 - man/outstandR.Rd | 14 +- man/result_stats.Rd | 2 +- man/simulate_ALD_pseudo_pop.Rd | 6 +- man/validate_outstandr.Rd | 11 + scripts/exercises.html | 4591 +++++++++++++++++++++++++++++ scripts/exercises.pdf | Bin 0 -> 84751 bytes scripts/exercises.qmd | 597 ++++ vignettes/Binary_data_example.Rmd | 102 +- 20 files changed, 5344 insertions(+), 112 deletions(-) create mode 100644 man/validate_outstandr.Rd create mode 100644 scripts/exercises.html create mode 100644 scripts/exercises.pdf create mode 100644 scripts/exercises.qmd diff --git a/NAMESPACE b/NAMESPACE index 1e6062a..af0b78e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,9 +18,11 @@ export(calculate_ate) export(calculate_trial_mean) export(calculate_trial_mean_binary) export(calculate_trial_mean_continuous) +export(calculate_trial_mean_count) export(calculate_trial_variance) export(calculate_trial_variance_binary) export(calculate_trial_variance_continuous) +export(calculate_trial_variance_count) export(get_treatment_effect) export(marginal_treatment_effect) export(marginal_variance) diff --git a/R/calculate_ate.R b/R/calculate_ate.R index e60e9ef..b118ebe 100644 --- a/R/calculate_ate.R +++ b/R/calculate_ate.R @@ -28,6 +28,8 @@ calculate_ate <- function(mean_comp, mean_ref, effect) { ate <- qlogis(mean_comp) - qlogis(mean_ref) } else if (effect == "risk_difference") { ate <- mean_comp - mean_ref + } else if (effect == "mean_difference") { + ate <- mean_comp - mean_ref } else if (effect == "delta_z") { ate <- qnorm(mean_comp) - qnorm(mean_ref) } else if (effect == "log_relative_risk_rare_events") { @@ -91,11 +93,21 @@ calculate_trial_variance_binary <- function(ald, tid, effect) { statistic == "N")$value effect_functions <- list( - "log_odds" = function() 1/y + 1/(N-y), - "log_relative_risk" = function() 1/y - 1/N, - "risk_difference" = function() y * (1 - y/N) / N, - "delta_z" = function() 1/y + 1/(N - y), - "log_relative_risk_rare_events" = function() 1/y - 1/N + "log_odds" = function() { + 1/y + 1/(N-y) + }, + "log_relative_risk" = function() { + 1/y - 1/N + }, + "risk_difference" = function() { + y * (1 - y/N) / N + }, + "delta_z" = function() { + 1/y + 1/(N - y) + }, + "log_relative_risk_rare_events" = function() { + 1/y - 1/N + } ) if (!effect %in% names(effect_functions)) { @@ -127,12 +139,16 @@ calculate_trial_variance_continuous <- function(ald, tid, effect) { statistic == "N")$value effect_functions <- list( - "log_odds" = function() pi^2/3 * (1/N), + "log_odds" = function() { + pi^2/3 * (1/N) + }, "log_relative_risk" = function() { message("log mean used\n") log(ybar) }, - "risk_difference" = function() (ysd^2)/N + "mean_difference" = function() { + (ysd^2)/N + } ) if (!effect %in% names(effect_functions)) { @@ -260,7 +276,7 @@ calculate_trial_mean_continuous <- function(ald, tid, effect) { message("log mean used\n") log(ybar) }, - risk_difference = function() { + mean_difference = function() { ybar }, delta_z = function() { @@ -349,7 +365,7 @@ get_treatment_effect <- function(link) { link_map <- list( logit = "log_odds", - identity = "risk_difference", + identity = "mean_difference", probit = "delta_z", cloglog = "log_relative_risk_rare_events", log = "log_relative_risk" @@ -389,6 +405,13 @@ calc_log_relative_risk <- function(mean_comp, mean_ref) { continuity_correction <- function(ald, treatments = list("B", "C"), correction = 0.5) { + # missing value + needs_correction <- any(ald$variable == "y" & ald$statistic == "sum") + + if (!needs_correction) { + return(ald) + } + # check if correction is needed in any group needs_correction <- ald |> diff --git a/R/outstandR.R b/R/outstandR.R index 5cdaa5b..2bcc4f1 100644 --- a/R/outstandR.R +++ b/R/outstandR.R @@ -9,17 +9,17 @@ #' @param ipd_trial Individual-level patient data. For example, suppose between studies _A_ and _C_. #' In a long format and must contain a treatment column and outcome column consistent with the formula object. #' The labels in the treatment are used internally so there must be a common treatment with the aggregate-level data trial. -#' @param ald_trial Aggregate-level data. For example, suppose between studies _B_ and _C_. The column names take the form -#' - `mean.X*`: mean patient measurement -#' - `sd.X*`: standard deviation of patient measurement -#' - `y.*.sum`: total number of events -#' - `y.*.bar`: proportion of events -#' - `N.*`: total number of individuals +#' @param ald_trial Aggregate-level data. For example, suppose between studies _B_ and _C_. The column names are +#' - `variable`: Covariate name. In the case of treatment arm sample size this is `NA` +#' - `statistic`: Summary statistic name from mean, standard deviation or sum +#' - `value`: Numerical value of summary statistic +#' - `trt`: Treatment label. Because we assume a common covariate distribution between treatment arms this is `NA` #' @param strategy Computation strategy function. These can be #' `strategy_maic()`, `strategy_stc()`, `strategy_gcomp_ml()` and `strategy_gcomp_stan()` #' @param ref_trt Reference / common / anchoring treatment name; default "C" #' @param CI Confidence interval; between 0,1 #' @param scale Relative treatment effect scale. If `NULL`, the scale is automatically determined from the model. +#' Choose from "log-odds", "log_relative_risk", "risk_difference", "delta_z", "mean_difference", "rate_difference" depending on the data type. #' @param ... Additional arguments #' @return List of length 3 of statistics as a `outstandR` class object. #' Containing statistics between each pair of treatments. diff --git a/R/validate_outstandr.R b/R/validate_outstandr.R index 741128f..cec9753 100644 --- a/R/validate_outstandr.R +++ b/R/validate_outstandr.R @@ -9,7 +9,8 @@ validate_outstandr <- function(ipd_trial, ald_trial, stop("CI argument must be between 0 and 1.") } - if (!is.null(scale) && !any(scale %in% c("log_odds", "log_relative_risk", "risk_difference"))) { + if (!is.null(scale) && !any(scale %in% c("log_odds", "log_relative_risk", "risk_difference", + "mean_difference"))) { stop("scale not in available list.") } diff --git a/man/IPD_stat_factory.Rd b/man/IPD_stat_factory.Rd index 7a577cb..c20c9e2 100644 --- a/man/IPD_stat_factory.Rd +++ b/man/IPD_stat_factory.Rd @@ -13,6 +13,6 @@ IPD_stat_factory(ipd_fun) A function that computes mean and variance statistics for a given strategy. } \description{ -Creates a method for computing mean and variance statistics based on the supplied function. +Creates a method for computing IPD mean and variance statistics based on the supplied function. } \keyword{internal} diff --git a/man/calc_IPD_stats.Rd b/man/calc_IPD_stats.Rd index 8c42b3a..67eeb5f 100644 --- a/man/calc_IPD_stats.Rd +++ b/man/calc_IPD_stats.Rd @@ -25,7 +25,7 @@ calc_IPD_stats(strategy, ipd, ald, scale, ...) \method{calc_IPD_stats}{gcomp_stan}(strategy, ipd, ald, scale, var_method = "sample", ...) } \arguments{ -\item{strategy}{A list corresponding to different approaches} +\item{strategy}{A list corresponding to different modelling approaches} \item{ipd}{Individual-level patient data. Dataframe with one row per patient with outcome, treatment and covariate columns.} @@ -51,21 +51,21 @@ and G-computation via Maximum Likelihood Estimation (MLE) or Bayesian inference. } \section{Multiple imputation marginalisation}{ -Using Stan, compute marginal relative treatment effect for \emph{A} vs \emph{C} for each MCMC sample +Using Stan, compute marginal relative treatment effect for IPD comparator "A" vs reference "C" arms for each MCMC sample by transforming from probability to linear predictor scale. Approximate by using imputation and combining estimates using Rubin's rules, in contrast to \code{\link[=calc_IPD_stats.gcomp_stan]{calc_IPD_stats.gcomp_stan()}}. } \section{Simulated treatment comparison statistics}{ -IPD from the \emph{AC} trial are used to fit a regression model describing the +IPD for reference "C" and comparator "A" trial arms are used to fit a regression model describing the observed outcomes \eqn{y} in terms of the relevant baseline characteristics \eqn{x} and the treatment variable \eqn{z}. } \section{Matching-adjusted indirect comparison statistics}{ -Marginal \emph{A} vs \emph{C} treatment effect estimates +Marginal IPD comparator treatment "A" vs reference treatment "C" treatment effect estimates using bootstrapping sampling. } @@ -76,15 +76,20 @@ Compute a non-parametric bootstrap with default \eqn{R=1000} resamples. \section{G-computation Bayesian statistics}{ -Using Stan, compute marginal log-odds ratio for \emph{A} vs \emph{C} for each MCMC sample +Using Stan, compute marginal relative effects for IPD comparator "A" vs reference "C" treatment arms for each MCMC sample by transforming from probability to linear predictor scale. } \examples{ \dontrun{ strategy <- strategy_maic() -ipd <- data.frame(id = 1:100, treatment = sample(c("A", "C"), 100, replace = TRUE), outcome = rnorm(100)) -ald <- data.frame(treatment = c("A", "C"), mean = c(0.2, 0.1), var = c(0.05, 0.03)) +ipd <- data.frame(trt = sample(c("A", "C"), 100, replace = TRUE), + X1 = rnorm(100, 1, 1), + y = rnorm(100, 10, 2)) +ald <- data.frame(trt = c(NA, "B", "C", "B", "C"), + variable = c("X1", "y", "y", NA, NA), + statistic = c("mean", "sum", "sum", "N", "N"), + value = c(0.5, 10, 12, 20, 25)) calc_IPD_stats(strategy, ipd, ald, scale = "log_odds") } } diff --git a/man/calc_gcomp_ml.Rd b/man/calc_gcomp_ml.Rd index 26a326d..8164d86 100644 --- a/man/calc_gcomp_ml.Rd +++ b/man/calc_gcomp_ml.Rd @@ -33,13 +33,13 @@ Computes the mean difference in treatment effects using bootstrap resampling. \dontrun{ strategy <- list( R = 1000, - formula = outcome ~ treatment + age, + formula = y ~ trt + age, family = binomial(), trt_var = "treatment", N = 1000 ) -ipd <- data.frame(treatment = c(0, 1), - outcome = c(1, 0), +ipd <- data.frame(trt = c("A", "C"), + y = c(1, 0), age = c(30, 40)) ald <- data.frame() calc_gcomp_ml(strategy, ipd, ald) diff --git a/man/calc_gcomp_stan.Rd b/man/calc_gcomp_stan.Rd index f27bda0..9da8a36 100644 --- a/man/calc_gcomp_stan.Rd +++ b/man/calc_gcomp_stan.Rd @@ -36,14 +36,14 @@ from the Bayesian G-computation method using Hamiltonian Monte Carlo. \examples{ \dontrun{ strategy <- list( - formula = outcome ~ treatment + age, + formula = y ~ trt + age, family = binomial(), iter = 2000, warmup = 500, chains = 4 ) -ipd <- data.frame(treatment = c(0, 1), - outcome = c(1, 0), +ipd <- data.frame(trt = c("A", "C"), + y = c(1, 0), age = c(30, 40)) ald <- data.frame() calc_gcomp_stan(strategy, ipd, ald) diff --git a/man/gcomp_ml.boot.Rd b/man/gcomp_ml.boot.Rd index bee3c38..48e00b9 100644 --- a/man/gcomp_ml.boot.Rd +++ b/man/gcomp_ml.boot.Rd @@ -19,9 +19,9 @@ gcomp_ml.boot( ) } \arguments{ -\item{data}{Trial data} +\item{data}{IPD trial data} -\item{indices}{Indices sampled from rows of \code{data}} +\item{indices}{Indices sampled from rows of \code{data} for bootstrapping} \item{formula}{Linear regression \code{formula} object. Prognostic factors (PF) are main effects and effect modifiers (EM) are interactions with the treatment variable, i.e., y ~ X1 + trt + trt:X2. For covariates as both PF and EM use \code{*} syntax.} @@ -36,15 +36,17 @@ See stats::family() for more details.} \item{ald}{Aggregate-level data for covariates.} } \value{ -Mean difference in expected log-odds +Relative treatment effect } \description{ -Using bootstrap resampling, calculates the log odds ratio. +Using bootstrap resampling, calculates the relative treatment effect, +such as log odds ratio, log relative risk or risk difference. } \examples{ \dontrun{ -data <- data.frame(treatment = c(0, 1), outcome = c(1, 0)) -gcomp_ml.boot(data, indices = 1:2, formula = outcome ~ treatment, +data <- data.frame(trt = c("A", "C"), + y = c(1, 0)) +gcomp_ml.boot(data, indices = 1:2, formula = y ~ trt, R = 100, family = binomial(), N = 1000, ald = NULL) } } diff --git a/man/gcomp_ml_means.Rd b/man/gcomp_ml_means.Rd index 1233ccd..f0a3b75 100644 --- a/man/gcomp_ml_means.Rd +++ b/man/gcomp_ml_means.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/gcomp_ml.R \name{gcomp_ml_means} \alias{gcomp_ml_means} -\title{G-computation Maximum Likelihood mean outcome} +\title{G-computation maximum likelihood mean outcomes by arm} \usage{ gcomp_ml_means( formula, @@ -34,24 +34,18 @@ We assume a common distribution for each treatment arm.} \item{N}{Synthetic sample size for g-computation} } \value{ -A named vector containing the marginal mean probabilities under treatments A (\code{0}) and C (\code{1}). +A named vector containing the marginal mean probabilities under +comparator "A" (\code{0}) and reference "C" (\code{1}) treatments. } \description{ -G-computation Maximum Likelihood mean outcome +G-computation maximum likelihood mean outcomes by arm } -\section{Log-Odds Ratio}{ - -Marginal \emph{A} vs \emph{C} log-odds ratio (mean difference in expected log-odds) -estimated by transforming from probability to linear predictor scale. - -\eqn{\log(\hat{\mu}_A/(1 - \hat{\mu}_A)) - \log(\hat{\mu}_C/(1 - \hat{\mu}_C))} -} - \examples{ \dontrun{ -formula <- outcome ~ treatment +formula <- y ~ trt family <- binomial() -ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0)) +ipd <- data.frame(trt = c("A", "C"), + y = c(1, 0)) ald <- data.frame() gcomp_ml_means(formula, family, N = 1000, ipd = ipd, ald = ald) } diff --git a/man/marginal_treatment_effect.Rd b/man/marginal_treatment_effect.Rd index c64fbef..acee43e 100644 --- a/man/marginal_treatment_effect.Rd +++ b/man/marginal_treatment_effect.Rd @@ -20,12 +20,6 @@ The relative treatment effect. } \description{ Computes the relative treatment effect from aggregate-level data using event counts. -For binomial data, calculates: -\deqn{ -\log\left( \frac{n_B/(N_B-n_B)}{n_C/(N_B-n_{B})} \right) = \log(n_B n_{\bar{C}}) - \log(n_C n_{\bar{B}}) -} -where \eqn{\bar{C}} is the compliment of \eqn{C} -so e.g. \eqn{n_{\bar{C}} = N_C - n_c}. } \examples{ \dontrun{ diff --git a/man/marginal_variance.Rd b/man/marginal_variance.Rd index 8e6a97a..973f40f 100644 --- a/man/marginal_variance.Rd +++ b/man/marginal_variance.Rd @@ -20,8 +20,6 @@ The total variance of marginal treatment effects. } \description{ Computes the total variance of marginal treatment effects using the delta method. -For binomial data, calculates: -\deqn{\frac{1}{n_C} + \frac{1}{n_{\bar{C}}} + \frac{1}{n_B} + \frac{1}{n_{\bar{B}}}}. } \examples{ \dontrun{ diff --git a/man/outstandR.Rd b/man/outstandR.Rd index a94f984..6e95f06 100644 --- a/man/outstandR.Rd +++ b/man/outstandR.Rd @@ -19,13 +19,12 @@ outstandR( In a long format and must contain a treatment column and outcome column consistent with the formula object. The labels in the treatment are used internally so there must be a common treatment with the aggregate-level data trial.} -\item{ald_trial}{Aggregate-level data. For example, suppose between studies \emph{B} and \emph{C}. The column names take the form +\item{ald_trial}{Aggregate-level data. For example, suppose between studies \emph{B} and \emph{C}. The column names are \itemize{ -\item \verb{mean.X*}: mean patient measurement -\item \verb{sd.X*}: standard deviation of patient measurement -\item \code{y.*.sum}: total number of events -\item \code{y.*.bar}: proportion of events -\item \verb{N.*}: total number of individuals +\item \code{variable}: Covariate name. In the case of treatment arm sample size this is \code{NA} +\item \code{statistic}: Summary statistic name from mean, standard deviation or sum +\item \code{value}: Numerical value of summary statistic +\item \code{trt}: Treatment label. Because we assume a common covariate distribution between treatment arms this is \code{NA} }} \item{strategy}{Computation strategy function. These can be @@ -35,7 +34,8 @@ The labels in the treatment are used internally so there must be a common treatm \item{CI}{Confidence interval; between 0,1} -\item{scale}{Relative treatment effect scale. If \code{NULL}, the scale is automatically determined from the model.} +\item{scale}{Relative treatment effect scale. If \code{NULL}, the scale is automatically determined from the model. +Choose from "log-odds", "log_relative_risk", "risk_difference", "delta_z", "mean_difference", "rate_difference" depending on the data type.} \item{...}{Additional arguments} } diff --git a/man/result_stats.Rd b/man/result_stats.Rd index dd09a48..14f2030 100644 --- a/man/result_stats.Rd +++ b/man/result_stats.Rd @@ -9,7 +9,7 @@ result_stats(ipd_stats, ald_stats, CI = 0.95) \arguments{ \item{ipd_stats, ald_stats}{} -\item{CI}{Confidence interval 1-alpha} +\item{CI}{Confidence interval 1-alpha; dafault 0.95} } \value{ List diff --git a/man/simulate_ALD_pseudo_pop.Rd b/man/simulate_ALD_pseudo_pop.Rd index aac456b..6a31814 100644 --- a/man/simulate_ALD_pseudo_pop.Rd +++ b/man/simulate_ALD_pseudo_pop.Rd @@ -28,10 +28,10 @@ Generates a synthetic cohort using a normal copula based on aggregate-level data } \examples{ \dontrun{ -formula <- outcome ~ treatment + age -ipd <- data.frame(treatment = c(0, 1), outcome = c(1, 0), age = c(30, 40)) +formula <- y ~ trt + age +ipd <- data.frame(tr = c("A", "C"), y = c(1, 0), age = c(30, 40)) ald <- data.frame() -simulate_ALD_pseudo_pop(formula, ipd, ald, trt_var = "treatment", N = 1000) +simulate_ALD_pseudo_pop(formula, ipd, ald, trt_var = "trt", N = 1000) } } \keyword{internal} diff --git a/man/validate_outstandr.Rd b/man/validate_outstandr.Rd new file mode 100644 index 0000000..1b014da --- /dev/null +++ b/man/validate_outstandr.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validate_outstandr.R +\name{validate_outstandr} +\alias{validate_outstandr} +\title{Input data validator} +\usage{ +validate_outstandr(ipd_trial, ald_trial, strategy, CI, scale) +} +\description{ +Input data validator +} diff --git a/scripts/exercises.html b/scripts/exercises.html new file mode 100644 index 0000000..9355aa3 --- /dev/null +++ b/scripts/exercises.html @@ -0,0 +1,4591 @@ + + + + + + + + + + + +Practical: Population-Adjusted Indirect Comparisons with outstandR + + + + + + + + + + + + + + + + + + + + + + + + + +
+ +
+ +
+
+

Practical: Population-Adjusted Indirect Comparisons with outstandR

+
+ + + +
+ +
+
Author
+
+

University College London (UCL)

+
+
+ +
+
Published
+
+

May 19, 2025

+
+
+ + +
+ + + +
+ + +
+

Introduction

+

This practical session investigates the use of population-adjusted indirect treatment comparisons (ITCs).

+

When we want to compare two treatments, say A and B, we ideally use a head-to-head randomized controlled trial (RCT). However, such trials are not always available. Instead, we might have:

+
    +
  1. An RCT comparing A to a common comparator C (the AC trial), for which we have Individual Patient Data (IPD).
    2. +
  2. An RCT comparing B to the same common comparator C (the BC trial), for which we only have Aggregate Level Data (ALD), like summary statistics from a publication.
    3. +
+

If the patient populations in the AC and BC trials differ in characteristics that modify the treatment effect (effect modifiers), a simple indirect comparison (A vs C minus B vs C) can be misleading. Population adjustment methods aim to correct for these differences, providing a more valid comparison of A vs B in a chosen target population (often the population of the BC trial).

+

We will use our {outstandR} R package which provides a suite of tools to perform these adjustments. In this practical, we will:

+
    +
  1. Simulate IPD and ALD for both binary and continuous outcomes.
    2. +
  2. Use {outstandR} to apply methods like Matching-Adjusted Indirect Comparison (MAIC) and G-computation.
    3. +
  3. Explore how to change the outcome scale for reporting.
    4. +
  4. Interpret the basic output from {outstandR}.
    5. +
+

Learning Objectives: By the end of this practical, you will be able to:

+
    +
  • Understand the scenario requiring population adjustment.
    • +
  • Prepare IPD and ALD in the format required by {outstandR}.
    • +
  • Apply MAIC and G-computation methods for binary and continuous outcomes.
    • +
  • Interpret and report results on different scales.
    • +
+
+
+

Part 0: Setup and Package Loading

+

First, we need to load the necessary R packages. If you haven’t installed them, you’ll need to do so. We have created the simcovariates package to use here for data generation which you’ll need to install from GitHub. The outstandR package will also need to be installed.

+
+
+Show/hide code +
# Ensure packages are installed:
+#
+# install.packages(c("dplyr", "tidyr", "boot", "copula", "rstanarm", "remotes"))
+#
+# remotes::install_github("n8thangreen/simcovariates") # For gen_data
+# remotes::install_github("StatisticsHealthEconomics/outstandR")
+
+library(outstandR)
+library(simcovariates) # For gen_data
+library(dplyr)
+library(tidyr)
+# library(rstanarm) # Loaded by outstandR if/when needed for Bayesian G-comp
+# library(boot)     # Loaded by outstandR if/when needed for MAIC
+
+# For reproducibility of simulated data
+set.seed(123)
+
+
+
+
+

Part 1: Data Simulation & Preparation - Binary Outcomes

+

We’ll start with a scenario involving a binary outcome (e.g., treatment response: yes/no).

+
+

1.1 Simulation Parameters

+

We use parameters similar to the {outstandR} vignette to define our simulation. These control sample size, treatment effects, covariate effects, and population characteristics.

+
+
+Show/hide code +
N <- 200             # Sample size per trial
+
+# Active treatment vs. placebo allocation ratio (2:1 implies ~2/3 on active)
+allocation <- 2/3
+
+# Conditional log-OR for active treatment vs. common comparator C
+b_trt <- log(0.17)
+
+# Conditional log-OR for each unit increase in prognostic variables (X3, X4)
+b_X <- -log(0.5)
+
+# Conditional log-OR for interaction term (treatment * effect modifier) for X1, X2
+b_EM <- -log(0.67)
+
+# Mean of prognostic factors (X3, X4) in AC trial
+meanX_AC <- c(0.45, 0.45)
+
+# Mean of prognostic factors (X3, X4) in BC trial (DIFFERENT from AC)
+meanX_BC <- c(0.6, 0.6)      
+meanX_EM_AC <- c(0.45, 0.45) # Mean of effect modifiers (X1, X2) in AC trial
+
+# Mean of effect modifiers (X1, X2) in BC trial (DIFFERENT from AC)
+meanX_EM_BC <- c(0.6, 0.6)  
+sdX <- c(0.4, 0.4)           # Standard deviation of prognostic factors
+sdX_EM <- c(0.4, 0.4)        # Standard deviation of effect modifiers
+corX <- 0.2                  # Covariate correlation coefficient
+b_0 <- -0.6                  # Baseline intercept coefficient on logit scale
+
+
+
+
+
+ +
+
+Note +
+
+
+

Effect Modifiers vs. Prognostic Variables:
+- Prognostic variables (X3, X4 here) predict the outcome regardless of treatment. - Effect modifiers (X1, X2 here) change the magnitude or direction of the treatment effect. Differences in the distribution of effect modifiers between trials are a key reason for population adjustment.

+
+
+
+
+

1.2 Generate IPD for AC Trial (Binary Outcome)

+

We simulate Individual Patient Data (IPD) for a trial comparing treatments A and C.

+
+
+Show/hide code +
ipd_trial_bin <- gen_data(N, 
+                          b_trt, 
+                          b_X, 
+                          b_EM, 
+                          b_0 = b_0,
+                          meanX_AC, 
+                          sdX, 
+                          meanX_EM_AC, 
+                          sdX_EM, 
+                          corX, 
+                          allocation,
+                          family = binomial("logit"))
+
+# Treatment 'trt' is 0 or 1
+# We map 0 to 'C' (comparator) and 1 to 'A' (new treatment)
+ipd_trial_bin$trt <- factor(ipd_trial_bin$trt, labels = c("C", "A"))
+
+
+

Lets look at the generated data.

+
+
+Show/hide code +
head(ipd_trial_bin)
+
+
+
            X1         X2         X3         X4 trt y
+1  0.420906647  0.6501898  0.6817174 0.61434770   A 0
+2  0.009771062  1.0476893  0.9321016 0.04336125   A 0
+3  0.086942077 -0.4289788  0.3807218 0.18401299   A 0
+4 -0.039661515  0.7256527  0.4987618 0.54389751   A 1
+5  0.585786267  0.2143042  0.2207665 0.64831303   A 0
+6  0.600816955 -0.3921163 -0.3156147 0.17139023   A 0
+
+
+Show/hide code +
summary(ipd_trial_bin)
+
+
+
       X1                X2                X3                X4         
+ Min.   :-0.7022   Min.   :-0.7504   Min.   :-0.7311   Min.   :-0.6038  
+ 1st Qu.: 0.1864   1st Qu.: 0.2158   1st Qu.: 0.1819   1st Qu.: 0.1820  
+ Median : 0.4603   Median : 0.5231   Median : 0.4557   Median : 0.4032  
+ Mean   : 0.4636   Mean   : 0.4723   Mean   : 0.4390   Mean   : 0.4289  
+ 3rd Qu.: 0.7043   3rd Qu.: 0.7245   3rd Qu.: 0.7171   3rd Qu.: 0.6886  
+ Max.   : 1.5292   Max.   : 1.5804   Max.   : 1.6463   Max.   : 1.3328  
+ trt           y       
+ C: 67   Min.   :0.00  
+ A:133   1st Qu.:0.00  
+         Median :0.00  
+         Mean   :0.32  
+         3rd Qu.:1.00  
+         Max.   :1.00
+
+
+

The ipd_trial_bin dataframe contains patient-level data: covariates (X1-X4), treatment assignment (trt), and outcome (y).

+
+
+

1.3 Generate ALD for BC Trial (Binary Outcome)

+

For the BC trial (comparing B vs C), we only have Aggregate Level Data (ALD). We first simulate IPD for BC and then summarize it. The key here is that meanX_BC and meanX_EM_BC are different from the AC trial, creating a population imbalance.

+
+
+Show/hide code +
# Simulate IPD for BC trial (using BC trial's covariate means)
+BC_IPD_bin <- gen_data(N, 
+                       b_trt, 
+                       b_X, 
+                       b_EM, 
+                       b_0,
+                       meanX_BC, # Using BC means
+                       sdX, 
+                       meanX_EM_BC, # Using BC means
+                       sdX_EM, 
+                       corX, 
+                       allocation,
+                       family = binomial("logit"))
+
+BC_IPD_bin$trt <- factor(BC_IPD_bin$trt, labels = c("C", "B")) # 0=C, 1=B
+
+# Now, aggregate BC_IPD_bin to create ald_trial_bin
+# This mimics having only published summary statistics.
+
+# Covariate summaries (mean, sd for X1-X4,
+# assumed same across arms in BC trial for simplicity)
+cov_summary_bin <- BC_IPD_bin %>%
+  select(X1, X2, X3, X4) %>% # Select covariate columns
+  summarise(across(everything(), list(mean = mean, sd = sd))) %>%
+  pivot_longer(everything(), names_to = "stat_var", values_to = "value") %>%
+  # 'stat_var' will be like "X1_mean", "X1_sd". We need to separate these.
+  separate(stat_var, into = c("variable", "statistic"), sep = "_") %>%
+  # Covariate summaries are often reported for the overall trial population
+  mutate(trt = NA_character_) 
+
+# Outcome summaries (number of events 'sum',
+# mean proportion 'mean', sample size 'N' for y by trt)
+outcome_summary_bin <- BC_IPD_bin %>%
+  group_by(trt) %>%
+  summarise(
+    sum_y = sum(y),      # Number of events
+    mean_y = mean(y),    # Proportion of events
+    N = n()              # Sample size in this arm
+  ) %>%
+  ungroup() %>%
+  pivot_longer(cols = -trt, names_to = "stat_var", values_to = "value") %>%
+  # 'stat_var' will be "sum_y", "mean_y", "N". We need to parse this.
+  mutate(
+    variable = case_when(
+      grepl("_y$", stat_var) ~ "y", # If it ends with _y, variable is y
+      stat_var == "N" ~ NA_character_, # For N, variable can be NA
+      TRUE ~ stat_var # Default
+    ),
+    statistic = case_when(
+      grepl("sum_", stat_var) ~ "sum",
+      grepl("mean_", stat_var) ~ "mean",
+      stat_var == "N" ~ "N",
+      TRUE ~ stat_var # Default
+    )
+  ) %>%
+  select(variable, statistic, value, trt)
+
+
+# Combine covariate and outcome summaries for the final ALD structure
+ald_trial_bin <- bind_rows(cov_summary_bin, outcome_summary_bin) %>%
+  select(variable, statistic, value, trt)
+
+
+

Viewing the data,

+
+
+Show/hide code +
print(as.data.frame(ald_trial_bin))
+
+
+
   variable statistic       value  trt
+1        X1      mean   0.5961081 <NA>
+2        X1        sd   0.4015645 <NA>
+3        X2      mean   0.5779233 <NA>
+4        X2        sd   0.3895705 <NA>
+5        X3      mean   0.5799632 <NA>
+6        X3        sd   0.3981054 <NA>
+7        X4      mean   0.5944841 <NA>
+8        X4        sd   0.4316603 <NA>
+9         y       sum  28.0000000    C
+10        y      mean   0.4179104    C
+11     <NA>         N  67.0000000    C
+12        y       sum  32.0000000    B
+13        y      mean   0.2406015    B
+14     <NA>         N 133.0000000    B
+
+
+

The ald_trial_bin is in a ‘long’ format with columns: variable (e.g., “X1”, “y”), statistic (e.g., “mean”, “sd”, “sum”, “N”), value, and trt (treatment arm, or NA if overall). This is the format {outstandR} expects.

+
+
+
+

Part 2: Model Fitting - Binary Outcomes

+

Now we use {outstandR} to perform population adjustments. We’ll compare treatment A (from AC trial IPD) with treatment B (from BC trial ALD), using C as the common anchor. The target population for comparison will be the BC trial population.

+
+

2.1 Define the Model Formula

+

The model formula specifies the relationship between the outcome (y), prognostic variables (X3, X4), treatment (trt), and effect modifiers (X1, X2). For a binary outcome with a logit link, the model is:

+

\[ +\text{logit}(p_{t}) = \beta_0 + \beta_X (X_3 + X_4) + [\beta_{t} + \beta_{EM} (X_1 + X_2)] \; \text{I}(t \neq C) +\]

+

This translates to the R formula: y ~ X3 + X4 + trt + trt:X1 + trt:X2 (The intercept \(\beta_0\) is implicit).

+
+
+Show/hide code +
lin_form_bin <- as.formula("y ~ X3 + X4 + trt + trt:X1 + trt:X2")
+
+
+
+
+

2.2 Matching-Adjusted Indirect Comparison (MAIC)

+

MAIC reweights the IPD from the AC trial so that the mean covariate values of the effect modifiers match those of the BC trial population.

+
+
+Show/hide code +
# MAIC involves bootstrapping, which can take a moment.
+# The number of bootstrap replicates can sometimes be 
+# controlled in strategy_maic() for speed,
+# e.g. n_boot = 100 for a quick check, but higher
+# (e.g., 1000) is better for stable results.
+# We'll use the default for now.
+
+out_maic_bin <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_maic(
+    formula = lin_form_bin,
+    family = binomial(link = "logit") 
+    # If your package allows, you might add:
+    # , n_boot = 200 # for faster demo
+  )
+)
+
+
+

The MAIC results (default: Log-Odds Ratio scale):

+
+
+Show/hide code +
print(out_maic_bin)
+
+
+
Object of class 'outstandR' 
+Model: binomial 
+Scale: log_odds 
+Common treatment: C 
+Individual patient data study: AC 
+Aggregate level data study: BC 
+Confidence interval level: 0.95 
+
+Contrasts:
+
+# A tibble: 3 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl>      <dbl>      <dbl>
+1 AB          -0.0495     0.226     -0.981      0.882
+2 AC          -0.868      0.123     -1.56      -0.179
+3 BC          -0.818      0.103     -1.45      -0.191
+
+Absolute:
+
+# A tibble: 2 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl> <lgl>      <lgl>     
+1 A             0.266   0.00183 NA         NA        
+2 C             0.461   0.00431 NA         NA
+
+
+

The output provides contrasts (e.g., A vs B) and absolute_effects in the target (BC) population. By default, for binomial(link="logit"), the effect measure is the log-odds ratio.

+
+
+

2.3 Changing the Outcome Scale (MAIC Example)

+

Often, we want results on a different scale, like log-relative risk or risk difference. The scale argument in outstandR() allows this.

+
+
+Show/hide code +
out_maic_bin_lrr <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_maic(
+    formula = lin_form_bin,
+    family = binomial(link = "logit")
+  ),
+  scale = "log_relative_risk" # Key change!
+)
+
+
+

The MAIC results on the log-relative risk scale,

+
+
+Show/hide code +
print(out_maic_bin_lrr)
+
+
+
Object of class 'outstandR' 
+Model: binomial 
+Scale: log_relative_risk 
+Common treatment: C 
+Individual patient data study: AC 
+Aggregate level data study: BC 
+Confidence interval level: 0.95 
+
+Contrasts:
+
+# A tibble: 3 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl>      <dbl>      <dbl>
+1 AB         -0.00612    0.0951     -0.610      0.598
+2 AC         -0.558      0.0505     -0.999     -0.118
+3 BC         -0.552      0.0445     -0.966     -0.139
+
+Absolute:
+
+# A tibble: 2 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl> <lgl>      <lgl>     
+1 A             0.264   0.00166 NA         NA        
+2 C             0.460   0.00456 NA         NA
+
+
+
+
+
+ +
+
+Tip +
+
+
+

Your Turn! Try getting MAIC results on the risk difference scale.
+Hint: scale = "risk_difference".

+
+
+
+
+Show/hide code +
out_maic_bin_rd <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_maic(
+    formula = lin_form_bin,
+    family = binomial(link = "logit")
+  ),
+  scale = "risk_difference" # Key change!
+)
+
+
+

The MAIC results on the risk difference scale,

+
+
+Show/hide code +
print(out_maic_bin_rd)
+
+
+
Object of class 'outstandR' 
+Model: binomial 
+Scale: risk_difference 
+Common treatment: C 
+Individual patient data study: AC 
+Aggregate level data study: BC 
+Confidence interval level: 0.95 
+
+Contrasts:
+
+# A tibble: 3 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl>      <dbl>      <dbl>
+1 AB          -0.0165   0.433       -1.31      1.27  
+2 AC          -0.194    0.00684     -0.356    -0.0317
+3 BC          -0.177    0.426       -1.46      1.10  
+
+Absolute:
+
+# A tibble: 2 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl> <lgl>      <lgl>     
+1 A             0.266   0.00192 NA         NA        
+2 C             0.460   0.00486 NA         NA
+
+
+
+
+

2.4 Parametric G-computation with Maximum Likelihood (G-comp ML)

+

G-computation fits an outcome regression model to the IPD (AC trial) and then uses this model to predict outcomes for each patient as if they had received treatment A and as if they had received treatment C, but standardized to the covariate distribution of the target (BC) population.

+
+
+Show/hide code +
out_gcomp_ml_bin <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_gcomp_ml(
+    formula = lin_form_bin,
+    family = binomial(link = "logit")
+  )
+)
+
+
+
+
+Show/hide code +
print(out_gcomp_ml_bin)
+
+
+
Object of class 'outstandR' 
+Model: binomial 
+Scale: log_odds 
+Common treatment: C 
+Individual patient data study: AC 
+Aggregate level data study: BC 
+Confidence interval level: 0.95 
+
+Contrasts:
+
+# A tibble: 3 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl>      <dbl>      <dbl>
+1 AB          -0.0774     0.230      -1.02      0.863
+2 AC          -0.895      0.128      -1.60     -0.195
+3 BC          -0.818      0.103      -1.45     -0.191
+
+Absolute:
+
+# A tibble: 2 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl> <lgl>      <lgl>     
+1 A             0.273   0.00224 NA         NA        
+2 C             0.477   0.00449 NA         NA
+
+
+
+
+
+

Part 3: Adapting for Continuous Outcomes

+

What if our outcome is continuous, like change in blood pressure or a quality-of-life score? The principles are similar, but we need to adjust the data generation and model specification.

+
+

3.1 Simulate Continuous Data

+

We’ll use family = gaussian("identity") for the gen_data function. We might also adjust some coefficients to be more sensible for a continuous scale.

+
+
+Show/hide code +
# Adjust some parameters for a continuous outcome
+b_0_cont <- 5      # Intercept on the continuous scale
+b_trt_cont <- -1.5 # Mean difference for treatment A vs C
+b_X_cont <- 0.5    # Effect of prognostic vars on continuous outcome
+
+# Effect of effect modifiers on treatment effect (continuous)
+b_EM_cont <- 0.3
+
+
+
+

3.1.1 IPD for AC Trial (Continuous)

+
+
+Show/hide code +
ipd_trial_cont <- gen_data(N, 
+                           b_trt_cont, 
+                           b_X_cont, 
+                           b_EM_cont, 
+                           b_0_cont,
+                           meanX_AC, 
+                           sdX, 
+                           meanX_EM_AC, 
+                           sdX_EM, 
+                           corX, 
+                           allocation,
+                           family = gaussian("identity")) # Key change!
+
+ipd_trial_cont$trt <- factor(ipd_trial_cont$trt, labels = c("C", "A"))
+
+head(ipd_trial_cont)
+
+
+
          X1          X2         X3         X4 trt        y
+1  0.3347920  1.25173997  0.8251443  0.3626829   A 5.287769
+2  1.3518916  0.34102429  0.7105816  0.2199213   A 4.530242
+3  0.8390412  0.15676647  0.6917419  0.3092831   A 3.491232
+4  0.8418207 -0.17637220 -0.2343619 -0.5699550   A 5.199625
+5  0.5758347  0.06594836  0.2838801  0.1641963   A 4.366868
+6 -0.3415192  0.58383236  0.4612317  0.1143282   A 3.391340
+
+
+Show/hide code +
summary(ipd_trial_cont$y)
+
+
+
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+  1.827   3.717   4.536   4.503   5.267   8.399
+
+
+
+
+

3.1.2 ALD for BC Trial (Continuous)

+
+
+Show/hide code +
BC_IPD_cont <- gen_data(N, 
+                        b_trt_cont, 
+                        b_X_cont, 
+                        b_EM_cont, 
+                        b_0_cont,
+                        meanX_BC, # Using BC means
+                        sdX, 
+                        meanX_EM_BC, # Using BC means
+                        sdX_EM, 
+                        corX, 
+                        allocation,
+                        family = gaussian("identity")) # Key change!
+
+BC_IPD_cont$trt <- factor(BC_IPD_cont$trt, labels = c("C", "B"))
+
+# Aggregate BC_IPD_cont for ALD
+# Covariate summaries structure remains the same
+cov_summary_cont <- BC_IPD_cont %>%
+  select(X1, X2, X3, X4) %>%
+  summarise(across(everything(), list(mean = mean, sd = sd))) %>%
+  pivot_longer(everything(), names_to = "stat_var", values_to = "value") %>%
+  separate(stat_var, into = c("variable", "statistic"), sep = "_") %>%
+  mutate(trt = NA_character_)
+
+# Outcome summaries for continuous data: mean, sd, N for y by trt
+outcome_summary_cont <- BC_IPD_cont %>%
+  group_by(trt) %>%
+  summarise(
+    mean_y = mean(y),    # Mean outcome
+    sd_y = sd(y),        # Standard deviation of outcome
+    N = n()              # Sample size
+  ) %>%
+  ungroup() %>%
+  pivot_longer(cols = -trt, names_to = "stat_var", values_to = "value") %>%
+  mutate(
+    variable = case_when(
+      grepl("_y$", stat_var) ~ "y",
+      stat_var == "N" ~ NA_character_,
+      TRUE ~ stat_var
+    ),
+    statistic = case_when(
+      grepl("mean_", stat_var) ~ "mean",
+      grepl("sd_", stat_var) ~ "sd", # Changed from sum to sd
+      stat_var == "N" ~ "N",
+      TRUE ~ stat_var
+    )
+  ) %>%
+  select(variable, statistic, value, trt)
+
+ald_trial_cont <- bind_rows(cov_summary_cont, outcome_summary_cont) %>%
+  select(variable, statistic, value, trt)
+
+print(as.data.frame(ald_trial_cont))
+
+
+
   variable statistic       value  trt
+1        X1      mean   0.5941535 <NA>
+2        X1        sd   0.3856699 <NA>
+3        X2      mean   0.5695096 <NA>
+4        X2        sd   0.4234775 <NA>
+5        X3      mean   0.5642288 <NA>
+6        X3        sd   0.3971081 <NA>
+7        X4      mean   0.5739154 <NA>
+8        X4        sd   0.3957993 <NA>
+9         y      mean   5.3318057    C
+10        y        sd   0.8647773    C
+11     <NA>         N  67.0000000    C
+12        y      mean   4.5914634    B
+13        y        sd   0.9994386    B
+14     <NA>         N 133.0000000    B
+
+
+
+
+
+

3.2 Model Fitting for Continuous Outcomes

+

The model formula structure can remain the same if we assume linear relationships. The key change is in the family argument of the strategy function.

+
+
+Show/hide code +
lin_form_cont <- as.formula("y ~ X3 + X4 + trt + trt:X1 + trt:X2")
+
+
+

Let’s use G-computation ML as an example.

+
+
+Show/hide code +
out_gcomp_ml_cont <- outstandR(
+  ipd_trial = ipd_trial_cont, 
+  ald_trial = ald_trial_cont,
+  strategy = strategy_gcomp_ml(
+    formula = lin_form_cont,
+    family = gaussian(link = "identity") # Key change!
+  )
+  # For Gaussian family, the default scale is typically
+  # "mean_difference", # which is often what we want.
+  # We could explicitly state: scale = "mean_difference"
+)
+
+
+
+
+Show/hide code +
print(out_gcomp_ml_cont)
+
+
+
Object of class 'outstandR' 
+Model: gaussian 
+Scale: mean_difference 
+Common treatment: C 
+Individual patient data study: AC 
+Aggregate level data study: BC 
+Confidence interval level: 0.95 
+
+Contrasts:
+
+# A tibble: 3 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl>      <dbl>      <dbl>
+1 AB           -0.557    0.0472     -0.982     -0.131
+2 AC           -1.30     0.0285     -1.63      -0.966
+3 BC           -0.740    0.0187     -1.01      -0.473
+
+Absolute:
+
+# A tibble: 2 × 5
+  Treatments Estimate Std.Error lower.0.95 upper.0.95
+  <chr>         <dbl>     <dbl> <lgl>      <lgl>     
+1 A              4.28   0.00703 NA         NA        
+2 C              5.58   0.0215  NA         NA
+
+
+
+
+
+ +
+
+Tip +
+
+
+

Your Turn! Try applying MAIC to the continuous outcome data. 1. Use family = gaussian(link = "identity") within strategy_maic(). 2. What scale would be appropriate if not the default? (e.g., "mean_difference")

+
+
+Show/hide code +
# Solution for MAIC with continuous data:
+out_maic_cont <- outstandR(
+  ipd_trial = ipd_trial_cont,
+  ald_trial = ald_trial_cont,
+  strategy = strategy_maic(
+    formula = lin_form_cont,
+    family = gaussian(link = "identity")
+  ),
+  scale = "mean_difference"
+)
+print(out_maic_cont)
+
+
+
+
+
+
+

2.5 Other Methods

+

{outstandR} supports other methods. Here’s how you might call them. These are set to eval=FALSE to save time in this practical.

+
    +
  • Simulated Treatment Comparison (STC): A conventional outcome regression approach.
    • +
+
+
+Show/hide code +
out_stc_bin <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_stc(
+    formula = lin_form_bin, 
+    family = binomial(link = "logit")
+  )
+)
+print(out_stc_bin)
+
+
+
    +
  • Bayesian G-computation (G-comp Bayes): Similar to G-comp ML but uses Bayesian methods (e.g., MCMC via rstanarm), which can better propagate uncertainty but is computationally more intensive.
    • +
+
+
+Show/hide code +
# This would require rstanarm and can be slow.
+out_gcomp_stan_bin <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_gcomp_stan(
+    formula = lin_form_bin,
+    family = binomial(link = "logit")
+    # For a faster demo if options are passed through:
+    # stan_args = list(iter = 500, chains = 2, refresh = 0) 
+  )
+)
+print(out_gcomp_stan_bin)
+
+
+
    +
  • Multiple Imputation Marginalisation (MIM): Another approach for marginalization.
    • +
+
+
+Show/hide code +
out_mim_bin <- outstandR(
+  ipd_trial = ipd_trial_bin, 
+  ald_trial = ald_trial_bin,
+  strategy = strategy_mim(
+    formula = lin_form_bin,
+    family = binomial(link = "logit")
+  )
+)
+print(out_mim_bin)
+
+
+
+
+
+

Part 4: Understanding Output & Wrap-up

+

Let’s briefly revisit one of the binary outcome results to understand the structure of the {outstandR} output.

+
+
+Show/hide code +
str(out_maic_bin)
+
+
+
List of 2
+ $ contrasts:List of 3
+  ..$ means    :List of 3
+  .. ..$ AB: num -0.0495
+  .. ..$ AC: num -0.868
+  .. ..$ BC: num -0.818
+  ..$ variances:List of 3
+  .. ..$ AB: num 0.226
+  .. ..$ AC: num 0.123
+  .. ..$ BC: num 0.103
+  ..$ CI       :List of 3
+  .. ..$ AB: num [1:2] -0.981 0.882
+  .. ..$ AC: num [1:2] -1.556 -0.179
+  .. ..$ BC: num [1:2] -1.446 -0.191
+ $ absolute :List of 2
+  ..$ means    :List of 2
+  .. ..$ A: Named num 0.266
+  .. .. ..- attr(*, "names")= chr "mean_A"
+  .. ..$ C: Named num 0.461
+  .. .. ..- attr(*, "names")= chr "mean_C"
+  ..$ variances:List of 2
+  .. ..$ A: Named num 0.00183
+  .. .. ..- attr(*, "names")= chr "mean_A"
+  .. ..$ C: Named num 0.00431
+  .. .. ..- attr(*, "names")= chr "mean_C"
+ - attr(*, "CI")= num 0.95
+ - attr(*, "ref_trt")= chr "C"
+ - attr(*, "scale")= chr "log_odds"
+ - attr(*, "model")= chr "binomial"
+ - attr(*, "class")= chr [1:2] "outstandR" "list"
+
+
+

The output object (here out_maic_bin) is a list containing:

+
    +
  • $contrasts: This list provides the estimated treatment effects (e.g., mean difference, log-OR), their variances, and confidence intervals for each pairwise comparison, adjusted to the target population (BC trial).
    • +
  • $contrasts$means$AB: The estimated effect of A versus B. This is often the primary interest.
    • +
  • $contrasts$means$AC: The estimated effect of A versus C.
    • +
  • $contrasts$means$BC: The estimated effect of B versus C (usually derived directly from the ALD).
    • +
  • $absolute_effects: This list provides the estimated mean outcome for each treatment (A, B, C) in the target population. This can be useful for understanding the baseline and treated outcomes.
    • +
+

For example, to extract the estimated log-odds ratio for A vs. B and its variance:

+
+
+Show/hide code +
log_or_AB <- out_maic_bin$contrasts$means$AB
+variance_log_or_AB <- out_maic_bin$contrasts$variances$AB
+
+cat(paste("Estimated Log-OR for A vs. B:", round(log_or_AB, 3), "\n"))
+
+
+
Estimated Log-OR for A vs. B: -0.05
+
+
+Show/hide code +
cat(paste("Variance of Log-OR for A vs. B:", round(variance_log_or_AB, 3), "\n"))
+
+
+
Variance of Log-OR for A vs. B: 0.226
+
+
+

The vignette for {outstandR} (which this practical is based on) shows how to combine results from multiple methods into tables and forest plots for a comprehensive comparison. This is highly recommended for actual analyses.

+
+

Key Takeaways

+
    +
  • Population adjustment is crucial when comparing treatments indirectly using IPD and ALD from trials with different patient characteristics (especially different distributions of effect modifiers).
    • +
  • The {outstandR} package provides a unified interface (outstandR() function) to apply various adjustment methods.
    • +
  • You need to: +
      +
    1. Prepare your IPD (for the “anchor” trial, e.g., AC) and ALD (for the “comparator” trial, e.g., BC, which also serves as the target population).
      2. +
    2. Define an appropriate model formula.
      3. +
    3. Choose a strategy_*() function corresponding to the desired adjustment method (MAIC, STC, G-comp, etc.).
      4. +
    4. Specify the outcome family (e.g., binomial(), gaussian()) within the strategy.
      5. +
    5. Optionally, use the scale argument in outstandR() to transform results to a desired effect measure scale.
      6. +
    • +
  • The methods can be adapted for different outcome types (binary, continuous, count, time-to-event, though we only covered binary and continuous here).
    • +
+
+
+ +
+ + +
+ + + + + \ No newline at end of file diff --git a/scripts/exercises.pdf b/scripts/exercises.pdf new file mode 100644 index 0000000000000000000000000000000000000000..bc82a1227ed1d492bbd395a27158ae28e15a6d33 GIT binary patch literal 84751 zcma&MQ;;rDmu;DO(zb2ewr$(CZS$mU+s>1=ZR1PZ=>K+fL|4VFhk9AD9@g`oBgUR& zilX9lO!REfWXE^cZ_rE}gp7m^#@5ihybR)2wytK*4C1y%u4bZUCJv@%46-iwOSMLBpk54XEYZO+QoX*1qUL5vVq%wp6JF0Zt`ZSBEEjf z4yn~UZQFweWQWXB(W8Ay2>>VkWVHTYFfuVm{RX?gczgZ?0l&Q8@0VK-*FKs>9<8HI zJ%03^-J4Sn%A0S~Q(I#O^}FfEe$TrR9=Atky!E?hl5>n{pPv2#y~llrS1J#8Sfd8` z%>tI-(xZqaRUk8{jZ$5b8!V0XRW~oF!meE$2R$zw#EN$n+j>{G4q-JRtDY67FwLtG zp6`KZ*C2(AAZokE3rb@CsV(Jm({%_7^&UYO`ZDg6ZM``mQryqBRDKnTr9lrbdcupnps|Bb11!OU2ek?Tn^RvDovSBV-1L=M`Y+*hrLT?-g29gA{nM4 zihfM)wl~^OLor4DX9bym$N7@V--2rxVb(G7Lc0!az*(8E2R@zjgfHFZU&BdNPxa zo^El$lu440_#rFn5)WGe5StDrbEqEvH&R<%6m95YOsgMwT#&o24D$}2xtc{v^XR8V zZnGvjROV92>K@%vywqyyBUt3dSy{nb?0a^W?7+e`vK-s*2$~DGd~eJmyB%MyoRVWhgaR3YAmV?;TW*hnRNR&^9X;GGFtOaLhr)zK;0=4|FioG#QI8@s>6uyf z|H5HE!NvOYYUC-NdbP_Z8wM%faevl0r`r)9s4zI=WO{%K0r6sU48$(KlmmGslXd~K z-B^ae#Np~>NUd4Z9X9nt|MKXsf5ocrt7YZ;82eN67iOjzQw75rtsPMPWHd7-KbtB; zHyCFOlvvKuS%c(pb{YlzsRD7cQ3%)M16!G~4ziv+0jgsCK&ycFkLD82W9ZR5OSskIoU|MgwzI4 zEtZs+t;4>(8{t|&p+{L!pb#l&Xdeh2WrgZAOoE?ec7WDML&f7jlh)z=5}MSAfU3%RsXts-wwjX;oGg@Xp9d>+3xv-~k1C5a?Rbpx zEVZ`uh9we~6mv<0B~?=fFL8(3HvoGR zSv7|CARZVg#VAcdj1NA;9xQXtk_b}|o_%cCWHr5@iILROE->5B87*FBFpVAS(d}&8 ziG58?gIK+itsk+<7_NXN|1XH8yFIv?Zl!=vj9q=w8;h&_0()%uses3Dt9yJ% zxhk7^#^FD_!igml>m_@#6@E26e->_P4DXc zMto1B``P1mjc*mA7BdzRk;Vr--jY}8(4_cl#|ii1U~#7A&cWY@VoonyD(RZBNAl)G+3EhEFV5Ch35v^>`7KjP?$=2hwpt%*?O)2UV%4( z`rw83jQ~vzYWmR^on$VXxH{{;&KrJ4;4bb0RB5VYv*o6c8(QUtM;Us-zo}CunS!_S zHYqKKr)RIVyTI@w)ir^dor1zm&KZkvSH+9S`!Wm+?GAVj9oI6J9g{i4VPg;Ko_Zq& z_O}9^(|~Pt9pjmn%z9R$((c^~U{4J7I9ZJW zG1`72f|afL2BUKW6<7Enonwsj7XHffnTsA6jpRGhd`h|QLVC!g1HVTvLbx!JX9c5#;HhWvgK8yf^Eo%<9?N*1%rn~&yZ_P-al zeFooU+|o^MX{LhI7K5Fued@&d>X(vQ0r(pG1yWT4r!X3wuF)OefFWpb9Q~zOo;!ts z5q3>Ayh7r$2@ZR^`!j}L5R^HwIA}9_)Bg_`{?P~CkNAiWsMQ-|DQE# zk}6t(h9ZD6ft|Ap9E9Mn-CuK@Gk$(WB&C*>OCJ_rTp5qt=~6`b?U4b1vl8;C-{oWA z-zmU}LCK*0k1 zf{^!ZMDUfkluHWALD~ABPZYsNUa9KIj!}8*Zh1MkavFss%ouB$r4{Uq(cNy9Fd0gi zn6!tqLuRx%fJ8;xWnHKMMvNnq_c+QTFC+XO(OcvyTXyCudvF!l*L*j8ij(Qzo1NJk z(7zqQYMgsHunJ*I)uP}v^&))FuqMpCMbh&&v|_(OszG1VFM6ubycIPeisPP`!GQNF zRfv?AKjtx(q)G!PWC~G*t#}7MUx9N=Zs%Nj~vO)F+rgWRuTNBc9cxU zK%tK=;sjtJXLfK_B|`%XSVeyL)!)pJCZA?JW_Zb4q8Nld+k%B^d@CXAHONOM=rA^M zBBm_Smq^uO0snvyd8`ekh5wMeDg7do;qxTXfr4$?V--giLmy0JyaA zt!C))myWVI&zxvGH#sjGuB~U!j(wcuT=)WHd5YOoACt#8(87eq!A)ZH1dF zlB>r(P)f~*M74>h>w+0i)Jitmnkw$dufYdqDmu;IvO{tBhRFwyHxlJ|- zmcRGcEmiWQSe!;4eC6Jh$Ya~gi2DwD$fhY1oYkx_+G$B*W+B4GHh}z3{cPA2dv@cKN~UXaHi!K z9_Y5^8%l;2Rqi_ZdAh}rvQsgrUiFbeQ9yOkZ~Fj?<%)J1(76fgAu`ze-Wegxe!6bG zjp#Ejm;I=oP1WUbW%;zQwWjzTtVI+jPqRWd~-c_p}qtiHpz+1b{k*!Xe+H& zi3RTr+p#Vh87M6=nm{7N5y&tsb5|rQ7r3-zW_8 zZ%;YKQ_?VCV2K}QPC{eE+(j@Rx|qAe+NR;_V>WeZE0$ioY+e4dQIF?a6Zvn5%7(qq zZ0b`_%itr-yGLKFYfj5=Pr2ab(Lldr(w+rIDz%Tg7+0(9DwQ_K(feJ7U77;M6)#QO z-E!rYd=H|XQ)o);%=Y}k?ZX~>TiHopEzzK}ThSKzllls6*66D@F5TS*Dy>A_zNuZR z7KpO)tg7EjeGV?TXwtCRyJauOLnV9*L+pFF(_Ex)&)7rizDq6ynPOV;<`-W(ch757 z2h;OeTWY}={gsR%mfUUW9TO|JR0jZLarCI2v@qs&KY?Ln#061OPkBe+%Vn+^Kld z_UpX*3YWknvI{s^Y@t9?;Js1Ie-J|vH-PIIBaX=2kbu3ST~)QY>SZm9zqz#ldUP>m zR0CzH=C7v6un2-iO~~K(hbOXaKghN6XNpJZBL}+scBCl;0`|cEKCs915hk-~X9_w- zxCTl(Ob-8~QRdn-0|ENiHbtL9@YYdyrKFg7n)T`e9;Wo|};ePpwcx>B|#& zO7m7N{5gRgm%2Q70RjL1uj~77SKzx#$+d`>dP|n0L(AdWliMv-G>f-5Wj2c0+A$kB zt<4*a5(PpHS7NYcLx}^12p%|WEa=%0l|ax@?J$M0&d?9kKcu>8f=CMB6$fZ@M|y*C z%iFZ~kBQU+x(%iJ-e`SMglsv;zmyadix!opY1GEKi@n@Oegnhq>l)V|{6+K)c*pF7 zAiAiq_pTi%uTU@ybjao>pipJAYWV#8wcD=P-jE7zsRT|RP6MA6uhB&GmAOzQGmXk5 zx-tkA@qf}bt})GATg;=Uc)6{<43;PKch&9gcCS zD21i)DZ2Avl5&S8zxOr6S$z9T4oZh~hlH2_wx|!GAZUF@Y9UE204o^UtVT)9jEWl4tIl?oy8&CNPHzg=cX2-hPaHx-ckj6>6ss z)@Z<5Q9c-*&`CHVpqyNq2##eJuFmen9$dL}S{O_B5#W)jS#i;-{cNN?KA#qpO7rk| zC{Be*8R8d25 ze+d#}NTV}QK8vR^Y5jb=aG^;Oy4w%}^MvfM=CjZkJI&Lx9usQ3m3cb% z{1zqRI&cqGFfwDAa7e>-3OjfUcZ+}RVuqaRslVWUmYy68s5!hci;ibv%+dP6SSz44 z44yNCC=B&@*Uh|FNoI@qr1H{*OpPuVB01wz3Fzotp0um-@h*WxQNB6o=T!#kL8Rh_ zN7U6S940sTGgXq)*=Xz3J6sx2yDVj7c(DxHVj>=eaj0-}obo1uwM+Vgh|Y3^K*US& zgP2TrHaGPe!u~RXp9kH(B}I3grZ>y#2_yT4amAOqsN&+lCO;TZ_MWaqa=KTNlBEZX>nOE)&F@qd)d;>rjw_c zb6ca*gK%@Ur&hkLt>o2t{4}#lp$z1**h{3ZP^Bi_gAdvv_OFcAT-;XLOMbkJ)#B7Y zX9Kot9j!)&&WR_gRa$Mk;4JDCAzVr$&C+h!?_4$1ymu`DK9zPfy`BUNOkJ5 zH&1&%VEocU<7lZzPo^xVZg)X=GIUvAe_x5b`*nP!MrM4~`hs;wwBpU~?r{rH>xU13 zyYKi*1F!GTqs#7LpDkmxfD=6#t}IK`uaIXBJ<3e~+`%zCSA7Q=l6?h-r77FUEc}p} zH0CGmY9YMAjw=KE3qQ5FJuBm`nTV$bzG=SI6X#P}+ZTh4@|uR?2MzgcwTH+e zS1oSt&h3i)EWeADd^iNXZvgNs1m zSGz{_BI+_3#Z}VL>|1H2Bo}79Hi>-3&MVsCAmY_UJJ`rU?#78AOeu>dqh(?F-vo)( zjDn2VJMZfiC~qFxU1?i~wF9hQ!Jeru&d1E&Em-6mwnGtS_?%w~QpW__eP8Pp())Sw z#4LXRd%qf2HmESNf$;JxfXYB!N>E|+uthPGuw8KE36@wE3*S3tP$2VwSyW4-s4FOB z(j-|(3hYG-R1qC|Uof;r=mRC^&3tN$wL=QLv2#@@TBE2iPdCEqhO_Jxwa+d zMNnv>UREGE2$|q9NISyaq2}--#;UBz=Mm|w)$)lIGrZL|3P)_Q!b*7`Cqmp;;qyac z|3+^=w1Pm^V?)fXO8c$R?%zPWL|KWxV=XL8FCGpb^BN1S@-rF;ucpEa(z@Z9>@Yj5 zVXG*-SMXWu5)ninjrTUmVV_tzY6mBu_z5qx^f#63X-ROIBGp7ACr$Kx>vE)-&YB2g zGcNjaN5^|6q0n~|p!L3Ou8VSQB@6WJxRlri$c4T7nc*?xNC;$7zxZ$a&KWO~Pde$S zN6xJZwoa06yp2#w+;Pt95;_Jw^{WY6si`GBY`kb*ZKwD1U>>CqGZ##?+oG+T94i>L ze2CdSDxQX;o2THF&6qbT6j4^Rp5&Z%LZRt@zX<&aC{ zzO;!Y7a}d66*rP{Imn=|G-Q!Z5C-Cnd(A0%qkJ;+X+|M*rqLsRh|&AgUnl^RtYIO=&NguRyW=%&+3Pl?vIcN$C46GSMu zG6kd7oMTk>-bfIJ9Xy3%_w?NA*j=N_DAeI4)=wRkCymNfuBy&Ns@zIQNu=K1b0ut0 zewRw#BExEyrS$%2AV)8K13YFpt|b3&7-eDnUl}5HMz;TIh-S2A;*ZG@`_8Do{>TLu z0m&5eiAt+a+7)+-ajh>cah)`L{zNDW8pYnrCTtapcH<{BR#w%&T|k(>@mC0i2Ut6D zf29vi2^;`yI(~L{M=TTliRTrn!v*@>!2^7cr*1Avrd z+&bX)_=~zQ>B7pKB=^)44yq0EBJu-NtQC#&a98epaZ-@MojNE{EeFS+=P0P+(vag) zKFCY`;MOqdGe=isIzCzJh~hFY)BE!R2>ku{?Z+xY!L~M$p0GQU=vpY0jzKSzWz$-^IbE526v7OLT%I6IZ5&8c?&~>4ys#DHjqxjXv;LJRjWbP^yH&2m-B?^O za|c?da&c-vX&3rdgR0(bFRPKl>WKn_MWH_bJTT%aqq60 zb<2xDM2;V#bm0xZVXH-@QZv$3IHSg|y$iaPYFwczm@Ny34%xrQ^PEnd3$9{~L~00m z#w){LgOtZ~$lw7+sX{#{_sM`p7F-?X%BNqH%;J(7)h5x#pLE%ww~ zMPRv=bdGebz4V*Dl{9A? zK{j}obB#KsXrGP@(#U(7NNf>xc8nQc5Jt0+g%@Gf`6Px`J1Tx^-!DQBMS+|sbZ7XG zr0+XC4oQb8gt9e(Khyy02?p)YS%V&w760c9U{xSy`EcIU9ZS-Z7E6W-85W z~Gg1*7c+DH9rb{y^jJ} zq;%VS)Iwd?dv%}qg{Fb%9QesSkf%NZ?7Gfx>v-{gKZ%~zAitldS~(y%XQNta@<*VM zIpT);CIn|rcdl^{fNwMLqX{kFu$NGoZpC`#icY{M6oswVZf|H=n74_{5K^ zTKQms&r#W}f&R`o^eQ;sqhlhKt8p8@JY&LwnuctwYJjW8_O{nwxGWTch_=P7*vcfM zTLtG>z1aOGUcOg}l7dJLXMoQl*h9;marr&H0TxuFkj+!t0{2`BlS*NZJl{`KR>RlA z5_-~F+V|wq#gRrZ3wr(+bbX27%PNfirPpP}2t|A2AMC8H z(PA!9lcciR{_Kc5_9@lKA6>(6F)O38gJa1wY(KeCLzrgByoXeyCEL5(L0Su36%4XW zDdeMQ)tGF>^quH!4)TtgN;9KOM;djhfn>a~34+5-u3q#1Ff`k1Nss8d+o8K94`H z`eRB&+uPr+BZ#^M$xK^7V5jRT7_NtH-o|7_tGsI7K+aMF_zkzE5+VMkoBYj{Q+wX^hY$3 zHcD@G70Jnd=w7n08me6yXipUxDev8V#PuRSG}2MUG@o`f%%}4?D%s8r4A7rN9rSWI z_`Z_UCRtfl&X z-3-IhHowEGXwNoEp6L~q+a1=$36WaTzfMf!a;~};e4B|=xmL;#i==fR#BSU)o2-vc z9{e8Ha@u`1{u?ld;qI?9`Dxb+^49k7!;deWDeXPgCwkA;)?YFYG8@Q8>EP@Rcyzfi^B$7Y^;$^rYGu4R5?K5H)mO@ z?00$M@<|~t?>D{gJ4-)+VE6aY^Wz<(R9-rovY4B%FE0gy`g{owe#6td=gW(slv}1U zzqCbL`ZcsZg2$}4lR@My8o@(d2X_D}{R!VuDJx^tx8(Ni=4i+up+7ekO(<*_GL&t4 zyrea;0L&VdCv5mJ_waGf)0gf$W zt}S^O(onZ3s@;KZb-?3UlnKafHuc!Yo0Z+GnN)4+!Qbw$8Sv|bsZEgms`@<(`y7t0GC|GF?i_nouQ%prB`%u<} z;w*&_3W8Z7)FVB!9K{Y*|5rxD5T=lQ-b#dLK_`iAip4dRGLD>GTA?o6VqZSTs@~f> z2oTg~Pel{vGNVXatWzyv>7t0RpLdiloFqP9$%vX{>Bj8Nm(_?qDS>3-Vs@)OsCnRq zX)4ti^Z4`0Npx!5f1Bbo2+mFt!9`5Q>B{G6EP|f?w-@G+)*x}Uy z3Nu?A;rpEA4WJGjFC)moQTsV21M|WPuPRa zR1qo#Lara!33)jDH$3;vkAk;t0?xJSkfGQY(3 zb)0I+afZAjcA#&FhsY<(90BGmi%m3EVz*N0A^p*dV1RA4B@e+;J9&s!!gS`u+0m6umava?oE+ro&~;pE#;6?ycoNhU(eI2!8O#_=aN zF0EXCa1nFY3?f=NzFn(aL<9zl0>RJ*CG_Gm&F8&**L*1|*}@rIa9|v98^Qzlfu(jj z5bP4@Hpn0!<4hZ4+m}~$o}(jz%p3{HoMRS%NJeS~#p8z#lZEIeg89A)MOf7Mw)W>o zPXBJKK4!onAi(%kpgi$wqBLdB23WbgL^F!?9;ycE=jr<7$@}A*C5NjYW4~L#>x1#Z zF831ya*Z1@l@h&vDwFZ_L%#7~RZ{5PIRTY*kwk3b7)E)%9c?>(dn-+Z>IiiO`3j7n zIK{F@F(v)|VNlf?DozKeg>GlfBi1(M&emixn7CuZA+vaIa4Q?k z0mVjseF;4S21<~?Wh5*-i7lc++4zzi-qF5NVbyYc!=at>Elm5I`;=>Fat2oUAwS00 zu692D6?Sx!nnIo@vy(757KLN@t5$ch5Qtq?_f2$Tl4_In+`^At2hLP>cAwu>kbx@z zjvJ*{w_@hY24jHFV`CKu(p@w+u5E!3d4&FTNOJpH38)gW>N_RjjF!iPWF-|VoLuWi zuRDp_jBLi3qfY}g800{?Pm%a;y8OZ84)``q{#`cxB-|OB=FnGmX7$tIE=(f+&*qQ+ zJ|9&P>TVNiMwnwg^{o%p6=gecGXPYTsnmXRZhMPrH+qeJuXE*Lb3A2vE7Qg*0#=)f z)YSPaQTh8H+l9O(0>njnTe;)SMe`OPRciR394<#!9T&#Gj>PL*&JFcMs@z-6e_@dW zx6=;bT+8vd>7I(q?Xb=rW(ZT6k0*+)r0-4_8CRVT-Ty(qc^QwwH4~h|adRCj#lqbv zA`H^}G{Cvg2*<`NL5s3tqK=m;+tM6g9H+k1Tg9F|&YXfk!5D0VR%KA(%Y|oTZT)RG zp|q6X0$8R^;R93_S|f8{#Ae|EDz#w*6yTR2`!+@p`t><&FFXzGz$z{(H&W-!RUA=D z3M3|?tOtbP>W!Udg+5FVXxlu!r~IXU7?WM-(Q37N!gA@Icxx4FFFR*-*c@3i;6{fF zw%a(T^bS+!oe^QT?}C;6&cAC@YIckUP$>(Gj?>WLqY7?*XYSd)wOc#qTs!tGTq389 zin=$2cje#}f zQA(69qTqcp*J%7VE&(jN!C~E7TDb$1E4m>H@dq0hDzD~ePwOsr9(>2mSJhop+uyri zo78l=tSSSUw}<+>&|%kc3aRi9z8SIqfdX9tIXxL}339&xQ|QV+HKq-obCG1_d#N^7 z+%JEBq3jAS^&NvDVwKu8a8@yL!ObJ_aKA&b%JzeJUMZ6$@=lS4qwKIko5CM1r3N`_ ze%SbTRfxGC0NC2roxu5hPZb`Qg)uX3N0;KiL6p8%-)EZxLVc~Z%=lRK&hHEWG}7lB z@du5&A9r6mwg(U8GT=?Ye0)vI_Cc%)lc^@@HrHnNl?{sP3lW@b-6WqElKiwGy8*`9 zAZ_y7+ZBxqd%URu_6tXRf}kF4#{g{{3=RK2$rE==jmujSZCAj-wKnj1s`~cd@*)?D z1Hks;Q2&;Z-Cu;PO;NTJU z_#Bv8JKL8HOkd3n53(`vY;3g21t#ZhFlTZ+IhurxTpW!=nF8!0?vl}$6A*gse6@$J z9r!luEbR4GVg{^Wr|*j1mL}36fGhcC;Rw@QoyAO8o&)V-MUcbBSLG68D36BmcSvK5 zxZEqLxnAQrh2O_O^UALwGjCXhkWvlTbr{nZCnRm1AmIBo{|Dh*WJ2+OU?BGY6$3Fb z{kL-HjE+pg7CU0!tHwD3?Gy(U;dr4SPC+}W4~_SE-Bq5qDyeyYrs%B!@+I-b86h?ziOpB>yf*$^x2u)1m1VMJ6Ro` z9?Q8*l%s+;!|m{DmT4*h-+tJ&gG-WivzEmO3@`*u3<3#{!RG!Rc!6K?VZy=scgpa! zOG2_9JpE83@d%!!{Cv*#WEZrb*i+q}h&f(8iH_g*`nA0X0|Od=FjCB<=;9jw7p7VZ z`7ZFKj7S(vtSNm?4_~a19QAeCAp%*Y3QoX>IDrA>0#+dWzIXILabJI?#n5i)dLj=d zZO(z7JGcs8o@u!QT|!IsE8PSgAiV29O>uTbxY~l4WPvva#MdFmwCV$*QyS za!Q$CW&20^KdjhfZ2Xx6n!nHyQ>IV{w$ZA58{h6weP6NDZ zL2QFxo*gdU>Gn)rJ7!&;G*J$C_>i!UdkD3et0$v-#Ev(?5j}a2iqOO~`A~XAcI;$0 z9@paAb21t;MR>t5&gBVgTxGR(9%%2Rdc@oyJ|Q0zCEy$xrWSeYV1njkW>HyECP^WY zJn?C>@Xj)7)YTbt!Wo2_c|eiCEE1B1*I6X+09KBLNlKblQ_A56(F!rqCy}K^o&#@p zoo8C`PT+%oZq;+5bS16%R;=Ng=c@E@GNfy(?@hSP;L$wJ9CnF&F`fUlv-`oQ=1Q0Y zkik}T+u|~tM{uh@mWmYhuzWN;tt>wRt zgLIv(wuiZsSNVq)(oVN))sqq(H>rAXl@=CPcw^+xjrWWSg5qUYT1#3!~_~fv|UlpYgPb_gTL8p)0EMKL;v-k+kCDniGdrzFRjvS zc6YX*>zF{xv%5Pg%l*{dsZf&FcjGN?y4V-OkL1Xs2UBN3QDu~vJEqBNjsrh`quxSO z(lq2wP)0{b=%KAa(+SGofc;{fby4Z7>ds^idZyW(d?$o@8i}SA$@sG3_duQgP!`TA zlCL?!#GVi~EJ;?&!4Kz*u}j9ua1dUQqGcIVHo^(z&@LKZIL?OeHb8QNOb8;koT$TF zpx=m|qi!{ue!&8ByhaQsQk=8}MXD1qtGW)?t@+22fv!{LociuO_cD}c?9qU8N%RE0 zdz}U&h82*)r1Z~NMD+?@Yh2e)d{|G-6BNdcJ0$h*!dV^WHV!nfN^2sX9w|!(_c1SC z5LYcFz3|P&f2wcFQ(a_*rA0@|K!H;;Og9Xu<@#x8w+v|HEOudMI~03IE2y#*ijc`^ zco<8KxT`v~Q~}rFv@Fn#?aD$aB?0naxFJXsOUgK>xi+za0TIc(7xc48aKfjXp}N*y zgyl|4q2#ZN{B)$kH}~#q!+{sJ(9`2Bu5wH?x7bz+>W%|~qC6X1ptg}3(Y2P_dQxFb z$n*w#td^$lsyDFzNRTv&Rs$QyW-N&lAmBO`yAO$z&XDLwCL;aSxP{GvHs0dhl7M2n zdRDbe-31m5(^updTWfyD+$#wut!)k+hZ9#gL#d0K-3}a7FrzZ`WJ!Y6vuMANg(;*Y zAY)v}6~qzc6^h-j>*>pI7k+_xYM4O-bJ>cQ`jeCPGwFN5+jjCm=y|KeHooc62yx-X zXOV057Z@G12=m!sAAA{6fu*5{U(ht73b>u$&b!X6ome6)G^4~i5nr0RVY`D}aIcY_ zt&yO@-yIW_q6tGB8E>AT9>1q zlk?kgxIZ7eTBP4J`didWkc(1~efwCg=w+#GK@a;;@HDyTw?(#P2dBUBwuS7i+4|4D z!+Da={mGvVgidiU*t2stR1xv56PYnNCH)jP1FkV$O%s+#4(Y* zmt}Ao%TE}owKx{roAMSjIPT3=Of4*6BU%_)l(b(MvG+4I^`HE+WkMK zW#dhfq}XKlMY?nXkd~w_H!qwPMa1j zb*umb1!GpkQ0av++M^YQ|Hw_k@`Bf*Qa6;InneDNb@lALCU2e{tUrRXiLQm@>u5)Z zD|&N>NJj=bMpDO0NqPR+wJTK{w>1Ukdga>LLp>JtXX3e{UgvRU9DjHCq`2RtBBcFp zbm)@Gy6*>Di9^IB1?LMumL&ESGt zeXS#!Rin2_QjXNM9c0A4x>(cgmArPEHRHHX0$kC~uAVC9AT3a%r~WC3Q^5Yt=eSQ> zD{_&AhL7^~eJPsX4Hf`L2+ZQ6Lk2B3`s)F9t?+F9SQS(==^*|zO@!idO=6`91g9sK z5@1p$TDaA@4rK7)6aJ$TEwJ&JTydG&#Hr zb`c7#!5;ZfVgTqscYDJ-z@GPJvr2P2e{9%=4D$z_w8FMxZyq&Ds2?cdM9nuu0iI=! zoDAK0y+IUCO{>^yuDXqM+!q0;gxX2TDJV1!GB3z>hFi@HLON z8}f(_;)PHG39Tdus!)1VdH(02i`)ACo|;J5XYmg-3kM7JCWZ~P+e!Z+q%qGdnJ7Jl z^q<&$GM%Foh(SGA{OZCQ1JCMF%Y(j+hAw_!+V7s0v{I_0iNy+xJM$Y93KW*Qb{ugC znd-mM=Vz*FxYXu(rEx;k3V&?u?gwjlqDDiaC%$z?;U_teMp3X%iX_>+E?;_O78_!B zcw@Wgq3}lXcx9NYRG2?qQaa4Kk0kT_u27v-K_8I|D@3Jg#f?@v*wAg1j|4(=VEqyW zqIq3X4=1phk3XKWqxew0%+#CnuTv#_DUi%PvJ$kGkzRq4Xyrf?e#Fq|vqYPV}>TDmhj>ns=6XY?=}w9G9u&{e(c z-9(HC(2l~DOr|Ov?UB3aqd2?Ws(e3FaO$bL+JM#oXN@SU*hT3|aC&%J$Lm~A)=TUn z({0(G9Bn@C776FR{~UlTrnPR$rR_o#y;5??&Jwaaz*XUI*j3)%NrD+f4~5;M-#Sg=zg^*q9Lf>B7c1w|CBWBsBT4m_W22xw zwAJ6FyD~lTOj-fN*ej)6FbzKzql_p!XyK?qXNSCblBh~@addrRn|ZFK^^;ho=psp^ ziyV0yg}|;`FsF@v`zhr~1hibS2Tj_qE0tH?T1gqu49nDc(*${iHxhNxaJWX}}l=cloJ9~SEBPRbL2Y323Lew*nh<-b$0 zJN;=!1N^&8S*p&y%h3?U(m;95f&UC`lJQ-H+es48giiYhTt=MBpLPP?m4xT$))aD@ zB}0+rY9OAR`Q{u6PL5VnSWBhA=71l2&yQ-QCTV01ZtZtK0y7rjbyn`lKH49r4qTp$ zu){1rcEBtYl<>{$`}n7UCTCDeV(*ry1n*#>?nQ9?d`ppbfWW))<@={(wtJ9D1R2SF zaLJ5vyYl=B-2=UkwwR9Z-S3Mpb?qfFv-c09Ky3e+u+HPqrz6_YWA6B?&f&~&L|VsD z9ho{e3tc|~lsrv!wvB2tipoS8y|hc*0F&EF<8X@mt1mZAIKghTR(+2}An(X|7k@qj zn~Be0rPXMC6=64)9^_OFWbM;Y?+YLO=1V;jlhSBlTSL;Nc@d452#Rgxd%6dEMq1y? z$lBsA={|&C&1%jgd>oDi%X|uA>?OnEAvSG0x91uuoU-jPvRy=bY!!#NkJ5Q6)Zu7{ z`TDM2&JtOpqKRmG*C%}^%_a3&b=JXtSBad|`m>}UQRo+g6YTfp%+u$Y&{2E6LhP4M z^kkz7$(exUUlD%&5?Q=eg}vSK&!>~j(lY|u`IpX}w8oh=2ZVspK*Urrp7GDGA|tVqyXN6v_8PJ33t+IJ5-bnZiZQ-9>EyxuX{iZu>&Jm2Rg?DW9?iqjjvcma; zFaIrOJMkdI4|X;!y(x#-Nt@hb5cmdRd^kJ!9|(l?f8#=!IM})V>wi$MmQ2F`OCTC= z2*arrE=xga+swUrKi*1{_0pY^0SORC ze0A#_rB52VS}A{eZ0I|{J#+7Pe%hdK>m`aE8Rq$P?>y&3{6~RmF|4@-pkzmAb{iM% zH_;;DA6#4hmNX6vES2v7sP;c83NLYGy3FyTf(3rQKR%x>Z4iVpgA5OCV@(jfg~vix zUP_~}_aRA1{V0rN|C~VHlhIri@-~`w$Z8Qq&l0Y%)N&RfGoRGd)!gKZMiPlEDPstZ z3$my2K;_ZZ+74ghLfVqF$TuaxhO{8x7R1N@lTX2(-Ix}RaPP!OqT&ew9vJB{)sw@N zImFz!Tjc`BQZB5|+CZZ*n}Ekce<>%NRyDW$PrG>~V#D|NFE}=^ByI3)%9-f=S2Y@I zJ&I9gRH?!|Fmg%M;-F=`4NVFu}p&>WhD5!&?B) zFp7mRV-n*S zA^8UynTsg^Ltv^~u{5?LZM;UD_;>=@wG{v>|G+x>F4Vsqn*P_Iuy<8*f<~09_U($; z3r!_`yl1txQ_ETV5DjPpS$F^_yE0$ zRT=?C77%sVL434`5c=< zRQEzY5K~ zeE;Be^Lwo~!f)}V?*)TZA0Ibt+6%MYACSlfex6uMYqKG&s4YiNX`R$ccvc=e%eMJT zfwPla6qM9kI^t!xUD?RK3ezfJ=AA4akk-F^CHjGy!Ki9bWTbFH6w^HqO71HV7Z%oP z5z`jW|4k4f({XR`Z8hq27L_xz`1O`jvW^jJeBV594#F=r-}B7c*JqZ-EYFkEtkTC; zf-t&<8b$uWE7wvEvSp)wk@ojd72+Le_VqLPK51xXq!Pf2^?? z>Z|#>taG`UEohCrTjoviXp2#IS0cZ54B z(?>#Wh>MY!9S_$09V}FXhk2rT@R~E4B0%G_j2YOq-TUvcKZK1+1FK%&^xFNwVFldG zlzX7&agce%pbOL)55@2FLXneG{ABt_-7=!=lIBi8LRcV&7k?pT^xCHt)tE1iN+KyuI=F6*&;3h{7;4vmY zxyTqEPCoZG9b0xT?N!U004mkcXZOR!Y{rS5c)c%+8f8Z%vyq++D`kFr+NV&qg)t~r z({?Wj%zce?rP8j}*2Pg8y`pB*mx1Skv-Sycn(9rRb%vyshFBSz)iuEfQ`S z;Cl@v@Sm!jBbKLp;}jKzCa~;&VC&zi#)uwzXzQ)k8#4zpsba1wiHa|VT?pX6Lb#AC z&nAi?AubOu3)+l{R2LmI0JF^lJ(|A^4wAxD1e$HAPi+u!v+b|jt>JA8YR*`ruizfI zP7^Z>ynDxWlIABf+qG23!;nwI;Opie6b!cZSNPznj~CpP*)rBO8m^$*J6Bz-AS7#q+@lAj&0lN z*tTukwylnB+qP{xGq!Vj?Xypvy=t!yzc2F-cxzT&;~C?+Z-9inGRA3*I;C4FKcG@c zvUnm{^K#*gBC(b9sP+!pX_1j=O+@qb4nQ;axgP%YlzkdbC_OA4LjBWy!HL`aMrEqt z&Vdjq(P4?1{xG?87N-3E>!nA9=tpzD(RtvASd)r~9QBpoARgZ*4BiZJ+JC_1KZ=zw zuraXxJ1)m!u-Fj(_DZ}#gd8hqVPZ@Y{Ib9JMiW5ent27?gs#lzuo~4dj*b(4JOSE89H={j^GBF*=FR^ z3xKn0Q_F?DBMOgRvg=#U&X4=I6QxS~V7D>s+U4W5b+t-3;Op!wZYI=3Z*wMRw5eRv z{43-{GD7A_p&Mm#sa|(W?udqw$l`(YD{fSZsVKmhso{x&YAeych*EeMmzF=(0u-Hr z0HgQbQZub$-(G$|2NBPZsrnC{(K+ElN~o;4W0P63)kD)P@fUMq&%IG52~~Ou^f@Z+L1g}FtcD6k zbb}v#1a-8^n~E(3`nFW3#p{YKF;C}5V?56*$}w#**c({OZlH+*8nZj;Plp6`(KHOA zd>BAe8CwB=BC_H%BAf^s)AG8I3LhqWy4XY6Q3}51#cboAR8?og^XhbQZSsgz37v?g z1<6L8u21*PAyD5==Dc6hMiBb-6#Ma!GQ+pwRAe+|StAIJ+t&4)Z0pI~ZEX3g9*0Z? ztSWZ2%a2~iy-<6tnDatO7};Ii9*H!&hS+-65eZ0R7|~Jz4AWyBB=54SDX-XsQy28%0egQR%(HB{?MwFyYl{V zzsjJBo6xwXrVLMqKL|O;l7^gell{YN7EBJ=yeSy}F42^lw>f0D*-sW#l6zVLy%SjcWkR;lSus^Lz8{8xChr^x-|0ec{0 z9^X?m&hk7OULiZs2!CUDo>h8YHAlpeMRrX_XA0-F1l)2G&^fG1rBYYg0WhW@P|T># zKK20!TU3~gPG?$F_fiCZG(QjF?b}VIk8lsS;vCt!B?hcC1!8RH;oeHS;-Ch{4Q>(3 zT~is$PpX+2mo7$i7NcTKM9U#Uhs&8ZT4frpP9cm@oAl_Xe6ZHR;6HB{Du^BFvZ*wI zyBK2bB{AAN*0O=u`tI=Z4pMbTg#@k^v;Yq99o@n1XF-L2D})cits9dRf~{pU!rsMO zrOQA-#xKIpX#X!#w$Dd%)0_7dE)$=O2>&GdvdKQZmrQ)lKn(gMkB1U&Z@#~S*F8_C z=1E`{Xf#AR*T;uX1KyolaZ2{G$YqWv+)vErnF-JV#|V{Oz>7T}xu%r8add>_292{| zS1MFtVv?|6WIPqOS3AXH^%M`S`n1`xruRsd(r@(e-2h0IpBIXvfId-T-ax1-wnHay z7O-s3^wkRgWskmrAIs36HjtVbcO|Y%;(XS=lM@t}Qf znpWj~U}ji)_!;bTpYun`m4YR$VtycLYSQ;?5%Som_N8Ck{{e8VCBvvQJ}11@7j+bg ziS9CB=7IJ*V!!Y|X^1;D8GEUPZXa0;NXDGmk7I%)vi;P6N!;ceJvN)iu0~&H`vJgu z3WG1W|8waP$-bv$t?@=MS&zE5rGR{Q6Dm(DQk|v%HGJ|{z=bc&!VA)zN{!bD1TdwJNFKJO<_>18-T=c(p0`BCm>#rd>CQCyU}{w9zpx zeg^-pYM!**Rc5z#UGN=?25ms^W{ZO&@+SIL!p4fcR?!#Z2FH^fp;$v>=M80r?_sHi*2P^3y1GIU_&gLw!TUNV zm$Q#t=47!|>kW2=kI{lijzj)-Cw@*8s)c`5wlIc;2fL$H{~kx)l>k=bDtbp#4=yLR z=4wK`eEU{WmapHkHso`5pxbJt>kRD!(&QxZi10y6QVtiOA~Q8+7{2zV%&tpx`}#Lg z8B^J2_P^1`^3No84kqURiM~q>Nn32Tzq@MHQ!PEzE<8Vd6tH!mwl?}%!Px=c&a*xW z%;(u2-2^0(sf&yC4DA+ktc`>8J+VX4h+KzK<7El=s-z7HR7PwGimu>>vS&NijSbza9pH`R zaD^kKj`q*XaV!W`k3iM0Vki66p_BoVA}jqqnq@Ck9NjgcACS2qekwnv35g2>pwba& zQEDlk;Tp`NoJ3>jYe}B#tCVMh4W4p6%e#~~xV0T6gJMzWS;Y&{en+-tZh`olcKeNV zIAoe>TZe0K;(~|T$yIqPyNXUFByj#R<7r%nPube4mdYhKjkQsIE9N0>z$B4wENRti zxUqu4@Cn^!9=MWz201k>rD+_jv%*$p1IfOH#C`Ao)j8r9Z(A%K(FE-&H$T&Acbz7V zs}=9s@Y}{@?dmBBTAxW?|1%RhCAOc1_?I+yT(s%NbfgA;qXRXs2-vOO!@9a1B#&s1 z$-{7FAa0}2PaeFHxdV1kUleb(L{X3byd_XFD9`vt5ZjCk6fN`4OXgt}GL zTKu+H0Fd0zIh0L--(?H8ker$adf0QQMuw%0ED4#BSD~JBiQqcl(m&&XFeY(%p(HTK z4G|>PGdo`t@!LKq%FeyJ+ACyLg3WmlOFB|KGf~{@OOUPy-*tBz1E+2GUTS+6F+fse z`Z3F-c8N<*XVr18dw|ZXzf?ZE<(g<<1hn+^GP}fU%ytc(;F7Y=^M~&e4^l{-TaJjVLhtF> z!!c~+tq~~@z(Kk#luo;=i3o~m_x?739gHudzP2Z3ET{d!?~36Dq18&aonTOezMWFA zf54isduv%TNC2FUCW-xEmhVh zA>}X&lY*>5FLa4+j=Y&%Yy`bVN{CU;R>-6?0(B<_a@BZM9YCwrz(=Z_43`abS6PByha$J1435rN!GaFU?ACgumJgdymX z-Y;ok>PNn2SS#Wo6_NN=rUIWCEz?}Gzq;_dR?%iT@tm%*urtGP_ukndhtAP%*Y_bZ zQ1EFYGDWubg?z#}q-ScccsaR4L37<`w7w<1LWKIY_D@rGB{x<&LSbZEGWu*CeXj%` z5LcvYGun_6g5zr>HQQ>xfqFe{Q}==riZUhoiW2L!#iMTI`F#F`O!HHl(%(Q%sUpz} z^+N5EaD?*J&pOgW|6odmgLd?Btyx7>tCUHgA-kyd2G$~m<>$_sT}kJzdP)JI`i4KV zytV2!(&gogQ_-&~Rbz25t;qH3F@hUIHyv&5c0Q-$>uRyW!FAsW^Trd!w!lhox~90> z_QS5OPMTP892yLrMUR4tdYt&YSqpcGei#@5Y8<8HEQ6l#`uKjj{NveHD6;SfgV)oD zJVJ7TP8A$Jcb5xeI35*!(I7K>tgeo~f&oB zabS2i%|cqiI1uQ}j2WmXXMZ2@T2DOS7C#k1FH4s+5MaM0t!b~2((2ufaP=ym?pP-N z4Yqbm2PEL)KF0C611Rqyg*|tj zIqteW=Ry_`x{i1@E!(%q*NV&+d4Jz=;;vN2<-=0Ko8Y9}mf_KGYCUpZh3az2R(haC8 zGN!Sp(W(E5J$|#&Qskf0naga93-fqFudUN0Gp-VH;h6_Y@R`7P#smO&Ndx_vxNfPx zGNq|At9y|ylZ!~M`F=Rxq8*(itSMD?Yo6m*s`O?4C6HOd83O!lStKz>7#bJA8=I;6G!V~3+EufOc zI72?%>YjZb+{tmljU%>C*j6jF+sBpVv9q{)64nF}lXOE37dy{;`tjJmcb0R)2X!^g zc_2^Fr;puL1Z9?6u!bPSpPiIE1*2A^+#7)i8xPD9cCzb9A3yA2(MR+s0}Y-3YoQUC zQd7COR7F5#6<*o%rcmutYfOBImMnJPGOa%^U(lOs^-f?vqKUo{^H2;BM-$hX?rej@cKVeZQK6`dGQ>QcdRHAagX9~Qdbc-tUT5%+H-`I+1X zJ&mC`RH5E$gbeaV9f zM+w?y74a;RH}*#IjD71QVl2EYK^dXDlFHs8jn3M?R~W^@`(RGB#Nkkg;Ii-m4G@v` zPkKZ){LkW0%m|Ilqj_uqa@RQSKA+?R z544rV)#|-M`|ok01D#ErNFCRC74FfrFq&31^l9b%MQIGsnq}_I;p|HqaR*VKy0)-| zx@}#7&6yddm)bF_O@rk%Gt%*l{)<@p0NM_rREt8A`<(aB?!suo1xr`uZaT+Do+MKa zU6*Qgu>kX(?ltRrQlV0`0mdUYPHiWyT-7_iFCEW;DR>$1TXy~P*{Dm*Np@=|N7ftd0r)u&!y)r8uL z1|LbBbFydK$c%2k7{s2^!1>VZ$Q%Eoh4j$b$?sGW-bz17fX;oHsi0f{Tml-nSm9}<7zfMCyxUcvihyR zC!l8no4aAr3N7a{D(v8!2JLh5>o#7#6iPX4*CxE}pB9;uMkOreTJSNZ>){M4!wqX)FKXJj@_Sa%A@cZdRZ7tY*v;KaUd;{PPIRb;f%Ugf9RCl zOE=@H-q^fLD0@-`G(j8*J&TFV20#%wX9#qEyrm~?Lhs#k0CSeEY8(%o%g{Cbhi*Us@RSSUWTwTZa2*@WRmH6WzldQ-+$K5*{Ip|e$_~9d z8nOo&KY7tR>f;i?=E8lz4?n6U?GDY^_lz9#q*`ie53*~~<*+0ie5{1OqXOh#97tY% zp6@FY(gco-qK#&H4{&*|jpwhp$R8cMI6ObEfc+jZz1=&C+Vh$EgDgm|2pOwb`H0G3 zF#9$UVN3VO+d%)A;+CdGC3S`p{=8Vkr&fsi#NE}ZlnSM6Mg zLGw7`yHa=`Q^!w5$A?D08dK*+cW$$61zA|-Qr!P;KO3YM(F_( ziznG}a6W=TrPm~7!S>dwTbylY#dIP7GmUdJpN!K>yha05q!RUcje)-8^?Agna~)dr zA4tRgk4VGH`ftwl<-gwEn+Co&t4hLc{ERoL4LNe z^W=QH!2x}8l zW9SNT4B9iME({d!{Vu-05!unCX;wvkF6H!N1rn$9O^|`3^Z?tuv&XaC8o|X@(r%-! z7wuvO{F@5_SrAFYo19=UdI5(5-FZ(^rND3wy-PWkuisEwAcU30&K;|o)C66C`7m#3 zS@b?oeHHsPV3NG}RO-l}O1o=iPsGYo=w`SM3|Q@e8iTu%fa!6z;go{4pFR&08@K0q zX7i{X&AY<~zXFfhd*ZzBG$UwJds?1`;(?Z6UWWD5=RAw`MgSoXGFGdjUp+S#GwK%d z4LbNxYznEv^%NC-imgeaNvI#}8K{e}eVg+E24B+Qhdz;uOm3t6(I8RZ5n8IzEwcs7!?8YRv*9R& zgTWXLb=HA+bHQrfr5<2Y%n)K@bs%5FyIAY)Alw#cYAb!F3)wdQZ1Do$;BF8gFOzsQ zf`&o*-6qf)=mq3Lv{J*hQguir-HNFbF>ty6VBI{b0d9fY*_UBP}2Ic z?h(M3Z5NEd*LRZv!ejT0^?maeH~5&jXuAk8mlipC95GZfcWD{~4y4B7vbOWEZG&3w zL34>iqOecYt_jU!@S)u1uRl`j6*OO`C!AC2Y#t@H`x4SdR+_I&v4jM|kLrv=CX8#! z8QpaMwgJ{K!sy#$I08+MlBQ0q9fTwFtA*WQS}DpMxMHW`5QrxG6TN4tnnvxt26xe* zFAxU%5R`Qq+dm5s0hfo0xjsQUvaP2*iZb$ShX zE89ok)($7RIzVx|tbDckS(ke=-*F8ct}GN1gtJ`}0W@IHH${9JAo%aP!{ zB)of9GFZL>t?s4Gq&)asGxc;ntL3t26_k&GOn%s1WVvQ(WH7N^P=%52jhFLT#bmyF zQ7P9t>TN}u_!_^~UZt5$+JzfpQ>GTjYP+#qa1hF18g`$Mm|8ZtwiG=1NLyTb{po;l z!7V0uhbXo{q=tMy7~ ztx{%u=8ZyMN(SsNY4OA_51!9QW7C_F7B1o**)fQ1SqRgCPK+!C@foN~6z%bO;yX_5 z;+khE8d2*8sHq(4?dXqIcUV)Nr*fMT`L&WakL<hczkP8Rnep|l2+rM6 zZ}`_dN8?Yrbq-;L$`aIp;LJx`r!KLIp=p(8j?5+zm<|Izn&1W#-0;$woofez+79Hf zhQgcg?5$k5eRovHaOQKDsWp@N(B-{MnEGi6j31xe5ZHxEF>SNVXRJ%8or8l!ljlaB zgGN~Q@X*mF80qvvYvTgNzd800FSZX?1P)6+#qQy=wyHTsbw4^1KicE>MVxFcRsf%Mw-k^oJs< z)HGv@a&v2ezmRA}T?Gc5x206pepY+tV#gdc5abmcm%`NpKI^_X=dYvweo-HfUEY_v z{yu&woVc&JI@ryG>G$UD>(v%LpY4$;1CEJk;^qR`XEhfnJ8u^IZS_8=izj zKE-MVJmZ#_+y%$;f$;T~AmUHAtjYYtj8xyeFAvYBWKZ|({pJ39%gEUZ-+v3cx7`0F z?2bsM6_1?sTsJ+DRWZyP9(~$DY%9hxJ-{?J(`_P^g8gVpgP7%(onU85Me|HR!^2A$ zGc-fhSmB=IlAt4uJxVTpOcyC)r1a%Wb@A~$9_9PEe>r)0KOoGO`1wlrpN#uWCFUM4nn&eYK@zJGW$HDfb2Gj78fU%fi1C^b_RMMxf& za~?d+C0d*g8kgj^8f5Zm+*#ZFphCrZrvMuS50;X5l+Y-Xrx^)D z3?9bciBhL7g|@-1O_Or#AxhgUAu4on4-DG5Kf_f|SmRBir>~^rW1Hkc4T76YV2Sw) z($2G=AOWupRbS7bWCK}NMcrXIc@Yn&Wv(Eol~Ch>J96mhmIA%9 z8&B1u+aCBzn|~ed$Cfh3A| znd(8`Y7ecn+{9_CAr|JtfUub1r@rwo%%uc=S_Y9&?mc;g2guJ2vNUDBdKX8l!BVc; zfe@MRT_z-BH@mAzwBH@q)u*VjK(Q<`#5~+v8P4oJpnTXP&X&3upWq1%W)O9zh?uXFZt`oGE+gorM;!4_pFA zbC$_nUnRW5ndKiG^ddaFGp5!4wVr!5VIEtduC=uf;ilfd%Fxa9d@r~7EV&n%k%!jr zMlO4>=N@4>U~KGX53M+=B;#JH&g5^*-eX+unU{xAyEsb;%ra1Bog`i%q6;Wt+@5)Ooy8^#|&!SZ`L|`aS(>>0URvT{UjZ3gGUem6MI=b?~ zp`~EQyxJ=GuSSGT6nzYfzlQ3Rlak-kFoKqU!LKn{Nf$V{}T3;{s6*4)1_0A zl@9|Z!uK)|p#@(F5HyWIYsO?4Xl!;&OQZOtRk&aff@zVnMc&gYV2c-U4{y~C1_|}^ zwd)!{KDLmXGaZ@-;xKXr;UskUntv)6e}2gr>D>ck6~ouegu-w0<$oDDlCmmC8cNdE zZQO^4RDNnj^@3Hyd=!6O^Q@cdA9t8U@>1PA!)k)0j0Rh$_b-bot)P(adtq`U>h2E6 zBS)P8*;WW)>62o7bS$tfB)=5ES%#L+a^gsYzhH%~LO+)H=G&9vk3F%+QGhJ^L_ChP z+}OHo>$ep)P`W%lo*VEwIhWG9&kdLvQH*?^ES?+4IynSqTE@#TTwd#~4(ho#s?ueJ zeC)$a0`+^z(RryBXCojCvlf78GE~>XHV)U{%UcA>fped7hlk#N*|aPPew6gQqWc9R z?_QYsAJFoTR7^%jW~TqSj2qJW|7fYCl$QnR!-Z~yd1w~45r$7^U--W&=9q_C(vi4{ z6qlJRnZ4pI!TEux!t{+H0?6}sSYN<*DtyiN>vi`l-*+|NTB*~E=EO}4;(+cBC%o_W zeIg(DND{*U`X&28E<_R7feCiwQWO=-hZk1$z_X_jdKE|Djn;5ZRre#`uHGcT`dpiq!gX8L&c!sZ{&HqEUlSNkX^R zb6Qd<@l~z74V0Cdq^D9ot+KeCw~1Eui#;7Qphe1)AY|dX$9_^=EWl)??S%{yHei5> zN#r@yw6CeFOLb3{9ZX=jss^vKAP9t1TSZ{KaFpb-O?CKB=Y&F)a3D-ExIAevjz>MB z3wLRW#@^aK#g*gFP7I}vt)Jucwe^VQkL#p}%kuYq;iOCOtY|B-|GRx4Ty7ahY*jb->zs}lUyE<$GsA-ZYsQ?fzL$3wnj*SRm*P?nFU z^pBNq7z@O`_9Rz3)1{@um$h$XB}-=-{Gm09!D>uphUfll+ubJ76I7*71X*-3FalRf z7N;SdzWBxCYFQ1e2U_;y+Hl~<)xsMEy)RUnKJ__M1k{Z^b;m(iP(qQ`d&ey_%=>vEg*L0d*acaq_vF=ZwZ9 z-9T^kVd5S?&XurNP}SJxiEYMjaml%{AZ<#n!mlZxvS@VQC}iW~m|?I2=nr9l8m3SJOLtI#gp30R6jlaHZxc z{zU_&*UiIGUF^0QPC~|k4=l!HNCqWWB3X8PI3d}}ZA2L9B*q&B2x{2KqW&~?L&S$7 zB`OTP*5E}9#;z?!_nRsN#4`hbcd{uec8nVS>THoqTmI z{0@dvcwm-WV&7#2=N5sj5<5W<2NRfI@klx}f+Aah8mW-|L=!a=JN^;(qYK)_phnv1 zKCemJ8k;tW6)u*Rxr@DSo2h+LHEeBpuUKSPYLfHItKc^E?+d~qPJTlEncD^X+yh$y zzk;(@iv0$1mep0ZmOdY8yb`Ut*nka4DdU1TyE-zL?7CL@qIqTYV2Y=Sdv{Wtszrh+ zgT)rqEh8TLJ*nOQ=Q;zN!IJ*6S9sFANGJEQx(?fjW%m^A;Um1`Ngj5aj@-OGMZzVdPuij-t zTk6061?-SM8789P^J>X6Hko+fnUvvDBExR6(@C$2HU^xSLrbve&H*ou7^$?|k8Wl( zsicjHoy`wPpC$1~K$7}tz}iwxN*5u_mJoTTnL7%9Q|nN^-q-*^ zaVPC#O7`Q-X3WZpEZ(~zSQ1tX9rV?mNasJ7`ekhUAa-7<_OBI$Fyz~4Sld9)g`kA} z&MzXA3^|G+N}=z0e_G#4%>qT7I1^qLM9u-5pMA@rzoTG7tRv+?dWAP#gttQc#m1w0@=&FiPlqzg_xXe0IEnov>7OWd<1e(k=J-tOJp(= zwz=0EduZ%`^(woBYWx9}UySN@TgFG9n~VPXha;u66UrX9D-8;0J|IjZN%HvGGdaNG zkkb1|e*O0fcG^A}C?}c__UY6PPR`B4;6HMk)wJH|T;XQ>7nj4~WS?DRx>Uen)ay@poK$ zycR=SW`UlZo7uV?rj^sfGOkNBA zwD{s7{ zn=c7PSn`f2U5Z=tf-?qH^X=u9AR+t8)08v%TMC`#Yh?@2apk#5?@6Q=Su6yLKEt@BMaJyQ3zyl3Raye7^O-vqG{H(2{z! z!WVT0%Uc4m(51y?h~l<`Qz^dYs-p8fvikE4AoWq zi3C9A%r7FsT+#v2tvQTObks3WH<_VjTX{mb6d7n!b{RO`p9gH1(3epkC1(WSeP-9%`5=rh2WS2&N81APGMxo);fKK)MLq*l$wkc(NuV7ugBYATEG8e z`AEsWSp{ALj*?in!}>VJeEr8gq1R8bxCJsdt8?}JOs{bzx~_x_o)rHQIGyEZ;QL`z zCF7pJ6+|h1+1%gQp6rxht{5dVrtrvoTTSxHdY4&Gcu+w%xQXj8ON^jmZv&>GQZyGh* zCjS#}y_of0f_TAo?}+sygF1-dT|g;am_X#|2dFA?zobe<#{}wR)9E$7XOBLKHE;%J zG*|QVvx72zA6jAMDtsImSiT#f%oDl#=(V*`Y&^;6DhTocd}45RN4?!4LXPVgmk=VX zzpyCbs4)&{7};b$bFjRpPW?g2u6XR`Z>9q434oUIh8)fbScJ0(Bt&`^oTie4h;Cdj z)g>}Lwxb-Vh(OqKY|!AM*jUig-aXV2ll-9U-qm<>0bqXuVxS?{MdinqWi)Ev|)}EAlJG5Uw zNe~nVCOLvfonCrgwM=U?w=HG-$7!e5pBbHq zBPO7)E|hGk$W7UXM!!Jo`fD#do}+v%;R&(VvhHyJK%vE>y=Kvj#9bTzV#CN;q1ZUe z9JbJh9S6TR(?N#@vVDvq8SD5JuDC~>?20lfK0I9Ni5!YayUlP&v%TD{;Pu4Z^CH=m zz75x0ojsV^T!fX0Ds-6{B`29W#}8El8G$vKzZXeeoZr!nQ6W7pPKs%65|U&mdAx>! z&4^Y~`NiihYUW}}Ur1^!ocTmb4g>8g^f(jH<)B9rpkgBBtPkkSSx9Hn`kwN;SpSpQ zU#MMBy@(!=0@S?FJSC z%`i1W9JvFIPLc*oAT96LyZq_;lopQdjayqu2#0zt-skd=88s>{M}4 z{E&R1soUh5&`n&w_DRX`9ECR%aKUf0XB!JDSVvv%lp!{i{D76<>nIUekt($suFWH- z=3~j4I@a>+_835%)gCvgQ<~k~roT)gCje`8iw$z^;<6hl7kroHTx%(P=M0w@mlsVT zd!+GrrCOp9|_`|xXOwl(}xpWMy+VlIY!20- z!iwgho6lWX=y;246^~_>!H+JxxfLJvT?*lmJ>YEkbMQ{4&aky==5;1Qt27MS;1kai z>xwHUu_~T0uy!~RHwh>;E#%`Sd$DYoEC3ZykF!dWTyrU3KP<&HnWMF}B-*EcEgBiO zH6|v=oW_MIHpe%m9-P&1>RfN2iA-%Rwh8tn4S2(jUubOCd>IQ^EiF54!lSWeQDp2s z2S|>+d_1Op16g{9s$6z)4XA+$r;d{d|4B6OnVp z_4mLpkcV7f&9OZ)8lKJiuGWb%f5LO)5vMSt(4YA>m08DKXo@`Vh%*DI7M%H+va9zktY_=>Yr6g!lokXmCc6PQ-CPhf; z-HX4TAj=xkO}Zz2%Cj%ed_!p}rArO7{!;X^-gnMdU>J!v>Zsrk22|n9u(Wl8gh2!4 zl#?cZkMfp@Ig`>>C;8M-Rwp2@%)Li3m7tu1BBHwAR$0qv4fV{_`{i#`0aFbKoj`dg zGeIJ9kd>0AmNOXT2ziiHlM8ew@b++W)sP$^=m#|Sa13Ip0oGDZ{Rw`bk2$$YElOo! zBz0z`p@Y85L2})Fl%TNbxZ?0IaG#Ynnb)>n#)0KhZUg9yl1&3weIA`SZ>L0YaRa1CvN)r$@#tw=&P>wPn_Ku7ur+nca@YIWYrjf;1@}C0?5LT!@FB!{X=E!wjS~Z=Qw2XkGz?5jomL9vJS3+kGqx&C zew{}SqzwA#$wjdrtgbG03V5{!rG+8N6P_BPI>#y|U*>g1xfNBdsGy z>&`zY$G~Y`JTSbD_jwtNVHlM!igK=R1A_!D_Y2y%Yb5!v!%0`?x1Z-Js;UyVDxIFO zEy%RpLje2VC_r+ZX*iNG)C zR%B?dWQ>JO!6_nB$eMNDcd+A7dKcMxSY!VL54ofhbaU1(EW9DTl>oRf*xj zZu963_IK0)@4%)lMY8qq(eh!#L!lqesCS5Nb8Z<0#Akc@$xN>z6Zl=% zrO4Jh4D%b_PHfsm2@XHb)N0?=WZtzn ziWB6=;n*Vho0*dfD@2}vZ5*0LFYN`#-^h6=#6hy!%8ZoHB|WB%RQ<9>?$gXqW&|bn zN^eqQJF&2p;#4k^W{i!3-?7p)J;cxC&&^3rcwT7B3S7v|We{Odc;6CibQiBqt0i2V zHn*=k4G9Ey9NGqxB}+HvnZ?*R)?P{+aL~7pVH1PX6hNcxhX<|0`7`LK&`Zj@pri?g zm!uj@YMz{QXsHPcxG0j2563@6*v1nbD4B5A1-g{lVh?i}HeK2@X`sh>kEE%Qg6{PF z)hC8LzsMPan##1)rtR07GR#Q;9g{?!bPpKG4DshxA?E z2lACT@C4)I8=504=Kc5Qz#FF`iGKMf)loq0@LZv-AZ89JtimbA#m&y|!w*?#^{a`N z_dBCxbeh!0`OkZ`>`aQ#=Yh~zw>6woMRYJAEo#_4$eWOqQqE1h({Jj$tBIZb9oh0` z5r`qnvMlAnlD~(|TiH|FZrFi2)0}tHM9~W5nXhS5k-4Omh_u2DVuQGp5DdfMsOjK> zL&i2Di9O~r%P7QQe+6@W!$vz^i;S!00rpfIKKKLb_Ng3?8Nn9u^PZ4BOJv%4h(J~N zagR<+tRJvDb4<2huZ`c<@1=JBvfp27>Il%(obK6bsKyB>eZn|5+a6`7+kVPEvjSzg z4{kj;oLfu`zhDcXyl})oPm*y|aiOBWlArFmEWW8a!kaU`xhP;rNMWth?n>tF_iA#ixl0a4@=%m_=4 zihgU$N=Xeq5H7la&mCSzXsbE`TW#(yH_Fc zE{L*lTaA4JrOTWf7`Ph9N;2uuQKx^IqM)Ghp|3C8*dyC_C2z!uu4k8cm$FZwIF^@a z>Z4NFi!W0{EL>}h*k(dy?bOlc^B#Fz(pFEu($B0LS!!`-*4FR%db#m=ImpuhaR#qX zm`<^@k=^Jc&m-K>KaBF)M3!h8`w$aI_+!@ffIfkU8j_zesy|A3r)M4SVk043?bca< zJ*NbYsKj1GskD%wVPwOOK|jpm@XUc?Q=iY-DZ z5fxvT~Cac#6<|G7%$F zgL$4gVs{HFu+s_|+_M_e@t0W}&Dwa~Y|J7l9ZuCOK}r)qJl;7kNpM?5lh+lWc82Sy?tL*^>=)cj>ro9e`Y{5<6Jel(n`BqkCp(3wY9b ztTyb-)VCKwT=E2#^h6_filZ(h%a7eZXRiE6 z#TGt+kC_){SS+oGuh0AbsOr{4 z)k$TU{mHq>wqgmUw~!#!tnrFV!pm;IEPJXpmM0}6@XDY6vl#xXu}-c z8!eyRycSNmFJ(Q%mZ3t6jyZ&H+DNU)X=*GvHj|z~1IXW8+w6i@9okJBrxzLl!7lM! zBbHpnWmOv|D%BF5L_~5=ar>uNL92#z-zMbem+-j<}Py&Tq*q zv=wd|k+H!t=M1z@FvFZNKkr;cD;Nnq*AlXs(g-Oh+yXbs{^! z!$V?j5t~^3qp{3VPYXGjX&f2FtP-j8Jr_Uqica)MM+4WaOc=-$G;BYL2e-syGaxk^ z09--kAVt@k52^IfhR2zAkc>c%?7+ae*GUap#1PWh(lVGkjjE3+9I5)PK?FBRgIMY) z+}bUD8cI@Q3-ddRXps3?s~fM1qWi2+4a0Aq6%xu02DIGtlN!?E)eY-%H@Q}43*6^C zy+y;pe9r1?XtyLAFn^=i^9JaZMUIxZNq~DS?w67LEmMZ%0D+wvn8`dG5&(vdYgvLp zj$ad0i2?RQsgt*!QQv5W0wh&fDdt%ZJos_DCl>->DzN_1_T5jN#7XWQCTU2Q$+|?O zT;Oe*fL&K%eDIKJaiU$f|6zq|FOh)Ug~1Aoo8jm_tGIme=bcvywvWx*wVR7H5iSpi zfB0VQ&S5zzhbbcGh#E&FzBCjr!ljMMsfj9cU7hOLP%R_`jFl2at72F4ccdR>zamja z4fjZF(=zpGUT3k?tZ9KzeP>ATjnE~7IOEO_KCTp0C;1HP zK4bZS^LnU1%gLS}w`?hDZze>EoeBz%(zBY1o1)t3k$Lh`RaDr!J}`b()?S z+jN0YiWt06dBMpBhmR+Ml0KX$^3X?%=J!|`WK%^k9CS&VmmQg2u$?M18#&jK~Qb{{%vn{OSq`Ose=s8rM8haFgbc8l2 zlZ&;I45ihyGl;tro}>@NjRDNRL#%VC(yd=QU`dGh;R?YFx@W|De$)M)6&?^LN$L?) z%QIrSR3o$du|8yTIS6{Fkzavqj%fAMgr)`Mr+t-Ywr+uIp=+VaYWR@WNO@=>EwE&= zC3JK<9ebhZ&9<=(qaqxR-iA`-iu^H1r8yAdccLe!SsxPm%5gT8GsreT;)yb`pUxAqfOtjtW|A?6rv=nZd58O|xTV;rgZsAXEylsh0cMo8*BF9bm;p zI|yO=(%FMgz$%sKCxE#cb-}wHEiXa$>(5ma5Xx|#XdDisdN2mAPvq(teFx7=RRCU) z!m%&nvLKdR?a<)qu7OBi|6}jap)BI_$RHQtKo!ni9i#%0UsYs4q?QwK?1=a5+?NoI z(agiQIM>aTbOidF(G_z5Xk4Fkmq|4apOdScOo(s&)RcNEih4vrGR4QL))h7hB*3YC zScq=R0xI`{*Xml6N5l#nG|0p0V0rMpR6W(v6$i4hWLEJFZvvU?YB8 z|3XNGa;>`}o9=KOigtaxR}Y*(-B<`Zj^2tdAqQeaO=_!NnLNSel5akl!Pw1?A1%fl zugWf*3>pJa4uqLL2ll?J4bqZ=AXja;8(7GUMiS#CBp(~45e4a+mfBh|m~rPh^?O

;Fu!BLOp4J zvsEXkGL0SYCIb_z+l1D87>*`YF_nn9N}IRs_2wL-9Ye<0K}57C=be($C;K$~)<+rJ z1xiC0m+v!XujN{s`~HFseN7q_Z~o?m7JTy@&CT|KQIVUlW9BL0wvFnTwKRn1I<`sP z{GRTgSgiS3waDMXR^pU7@O-|8AIg_X`MSSYDh==6l6Dnq(wW=P9>xKQuW??E@9eM< z@tYJ&py94~nv(#A(k9N#P~sH*`$M#ZA`?tRTviqea7Ik$UKL)8A6ADGmw9$lc{c8f zq*5!yx+z7SN8J1Y!5l+#PD)?LWOQA|BAD@I2}@|=O*oIrn3oXKWBqkHoK)vd+-bfT zCSGP5m2nQkZ{X`A*SE%E?8jniuCtSAkxy;m9W3L&{p!L+c)v*rbelGgQB|W1jh}ip zhM%fl-^eO4@7$BH$+d6~B**wRyozhDmeNw~)W@8#Lo{ep$iKZ0TB}&!4VqR-NqDey z%+_rR?IK6@h^D+jBRAv;upm>zPqv~C6Ah0?U3H{~GZcAQY=@pwr1$r_C7+QKBdjo+ zzj{2>xYjt{+TWd|#joleSTQ<|XAev%wB$Dk9-d1508bLqZ~i5+bN&}L3=_jYU6{81 zmjgi>VW=EnBrl3N&|`|Boe2CzbG8!v*xv@{z@9vbOzly#>jp|VO*m2L!|So2B)3oQ zBFOD>%svD=Lg9e(n@qI8D;9>r=pzWbi;&d7>yON@-#JS z4XnH>pOoeqd7#Rhkd0LMEDSM8xCTs0YyDNT5C#Y{9W|&(c^6leQhWdzS#KbI(-w~} zL~y1-Di3-46*#9-$z~f2)5`(*8Y=mPsp!3&1Rfv1le13MVgMa=+b7FiCu%+r;deI> zUme3Du?V}=VCvXs(ND`@D~i>i`+G&?SDMcwj~au%j6Wmrm%J4aXh$&7*Q<5}z(!Y; zm?(z!VgYp=8Sgc^+d)-p)DglsFNYINO5Zlu!qW^ZmK7fo5#h-WZ}wbzU*Fm};0Ou& z)VhAfq?C@e3QNT(1~B9iqoQkOq=~DZSYdMpHm`|~l<)pgA+5$+a{|1Dzh@aR=t5ck zK73?08rJ55K%{31cDp^i6o5=m5d)BUE^e#+WJVD0+#LCJWSarMq_Tma+CHH1)Rix0 zUqb0^2B`(9?DD=oC~Z!dEtHvMTCQc9B7}aboTwQqJ>c}=YiO5!Sdnra0k>Ej6&cX| zgSOn9Itv1obsJ&9r08U$hmx>GNKGWg;*EE`%$0=(Lll?fuz0Nyva6xPvI)MW1~NgE z;;&RQtgi8V?&cFj#9@#zm_ICX+jI;}?NIU#n~o!b@ntk_6WY*z=J!0FH6}_byVi$7 zV)iHu>T)_y&V7_tGFw1cump!Nc7QV6&djqswV*Q3S+kuNShF;|Ub8g8umNN%5MDi= zuq?_tML=I@z~GsP+3N%<2Y_Q-UthgwQGq{fU;Dvt_qX{D`7)8s7sTN$SK=#bjiJI4g!vrP_oWaC$_ zE5T7=f?*}8kJ7@~?4H`RdBMFvx%CtHRL zZ6#1ZQ{cXw)JnC;c|cJ{KArb?mRYdeo}CC~W*u|r>F$?k!jwPKTc*#nk~2C70B6s{ z8_|okb7GEOmCdoemd&s7`7;J48pf7d6e-#+=c?B|^CUu1WTv0!94S91^KSPhN!=8S z=EG__gl8ODkJS7qV)IJ%!Om#{ndmKLr{?gDNheIjwTIC+x8Ic^ZIa-$MRS)W*NiAc z3CMC0#inavzntz;;BYLL3*eU^XPep!WP(l{EPXs}QUzJ;m|hyBluP1yOU9j>$7UKF z=Fn=FD_wl-P!scIHkegJdpk-hmY)pS(EO^0^-4?ldtk8qygTzxUML|Bh$^JR_IO$_ zD}@i88)VzmlYTg4OV2K7l~UC#6aiYS&b79_F~~rRgTf;hFmjAG0k`!rt{zC)x!Fv7 zlkIGCIBu36k!MWayy5Tk&zcRSK4Gz?S&@Z4&dD_jEZXz*t%4S6PDFO-iyWCu)?)6* zqw_yV1H-cYQ`qBRlJL*0Z&TceC87$mGpo76e(v1s3a^^M^(rBat?b?NmGg6o+AS+*VQW#hDJK9qqr>J|*nUm4Ad z3z2XqL_80nE|!wQNrgH0%+J~p_^6SWy#al-&;fj4M}Gn*&;~q74Sy3U;N7(QNPyIG z#${vTQ|F(@wacTC>V%cQ4B=?BLfTa~M4vCUmRR=o0o-4P>bflU?&1G4m_dI<t#0O zW|;tG*TUcz<>qfZ$sQdjcG2vQK2gfeK_G{qKUa!v^#(zGw2JQ9b0sLgHE*%9dxB7q zpE9#g0496{0_J7<8t2H`fjM!nW9#Fplsga(*V9)^*0M3A<(Tgx*SIQL+e=_3| zC=^yYn0q3JYU*1^B5r;udcEHm%VPbcDS>=e%HjX)*Y4as%q;ZwcKy}srOk;_)i87N z^va4-;QDhWEyb6+eeI{y1Setj@dsXeCJwhoxVjlwyM3?MZM{#a-S?a_wv-0%0Zi@b z>86!GE}1bwZIX&yK#&R@;_9(`Yw4N=KN&m^1dktK!zOW;kbjUQ!#w-#eXJ*ER|iQWYx|w z^(rO_O)Y(+dTXPJ=$b^%MWl3YicvoL90|JxYz<3+tE4PM;Ar1I_Ng;oB*|J1XI54@dJ%MXZ%}9 zy6xta*T5fQ5*m9nWymmi3q%*_YR5(m`P4tNI7~z&3~AmjDj9+Gl5@WCjgQMxvGKo; zxOEX2`>R0rJSZVPf|bGx7uU&+l2FqD4_#uu>o4A^?(pjMl%+*3^>$3F7_qAywsWWF zDt@Oap*r>GDkeeZuO4T>Ho~Y`(LI59R(g++)VuV4!EIRveDNLnD=~Tm@C@=zfPIHa zfs#pPDhIU{Keh}5r#BADN~I%#X0ee1i4P2xkde16M0pRGWRXkH9grNN*&R9-6yLxF zb&iK~4Am5EL@of4vh!&K2sCcJ6d9$@n`{E&ED@1Fvw~Z9>m4ec;IMA}QWYloZRf2@ zAmGn<)U;(BN=Q5?iZTGTWQbx38_0@EbkJ}iK3rKP?`=0%gDy+O({&f&~}X zKEi_&_DBDh(8-a=b$dvgwOzSx>xZC82fhItc0P-mHF;gN$!16eW(7qg5`2h*XoM4FJj@{^~l1@un8`2%sZvi9`N3UGZ;W)%nFG` zN1o@kvkE-KQqq@OKia7)DlfD6pwdH85vl9Cn*Wl6jNyB$*#y{@W`EC?W(@b-Bn^jj ze!ArlU6vr$G>lcaX@_>3{-#cwHCu|irdm<>mS}GPmPf^=_A=TSt<)^h0$Z64^cO3{ z-#Iq=GGQmfpyt*0B)hkzFV|ytsa+wN24n~eU#};$8*$Vx39+j#+8$w{;C6kBB#iwa z`o0!UWIxRvcMz;^67?uW6-fJ?F2>SfrfwH}E-t;}8O~uSS?N$xXFdKBSdvvnNkxuB zhb7Pm`5GDLr@8~0+%GTCB0W&UIyqh!zz6)LksY}zOY&ftZM4UcFI8EDenmJ!{i51^ z7s8M{S|@`6fxaegjrBQFH|>w4PQgd%e>Da)`-{wmTaqQq%MQStBqzyWb$1X7O3UW2Uis3jDyK0M4|uxzxU_@ds<&IF@v2>rBT%O;A>;3H8?e zQaH59hOl6qQ`XKNdROmx!r?k~$V=6)7a`b$Ux`PDB?r)L6%;isa5{7-zS$j4xMcu(`(=H@wrl&WW{3p9{kcxp}3U#d>_xw19>wgeCwYS!TTy8BEcw5TU^YqP;^9@;i5UANc!0Y5lh8#?YS zvak6|;A@}D#3;E)N}O`W>m5A2kP(8p;C`|fjF&YORz^%^*dWxI28>Keot#onX)M~z zVb;f;FdkGl8k1UXzKHk&G&UR+m`__G`@t$2#65vy72U=)P4~ z50?#huOz_)`NfRLKq;yx1sHUO+nvWVx!>S?T}TiA_nG$hru$zGH5RsiXbb8j3ECAh zAOzohLg8ywQ~lBJOeQJ{Vo_|$yt0&l-@pbWk6gqs9wq$o?Yk)t6_G50k2TwVa1WdK za=q!080_`lQFcW-nQq>W`I=%^&AKdhQlJvqU`3| z#Sg7;HOkX0B&PzZ9SEMoPs8p*eyiY zT{D%M+xpjI(8RS@w6)!XA6^OLmZ4-q*k#(+2ROu6-8FcJ|LW>X^51sFe`CaP{DTmu z6R%(u$bc}i^M&%V$`~=M(&-P8sfw^}JLwAVvvBAvBqJ0B@B5K1{9Y#j)H|`o@AmVm zk)GPMvg=1FNWD1woJENZs58Th1awiZJC@^IR(xVss`zY|q&N;`LX!9Ja_6hE(o*wXi#k!J zfs`A#p!LwK)lJ&5D%BY1On!3?CTnN@mGIk$jlDBN8{a2yU-p;WbUJoE zMaQm3o<4j>wxd)Pdp;f1hTHujs@tLQ9YV{zkw%e>UJ1>A`Bm1F>Bs9~diRvVkey%g2mx_^kHD+#h z?Csps!*Vc3A^p*WJHViM)r5ZeYO6%Qut(xj{n56dDTG2$f++TcFwNoDiGiK{p|#+I zq<26;M_WOI2~LF;kvs@ai5}ULjUm2*Py6(ElzsueN2X8^LSPaZhan8PO@^gvOb_I= z9@dlWmpnZhnX~zTc8WnS!{R{KJ9#}L-gZuEB4%6nhon|WBuUm`2BFVKdhES z_AWZRH~Fbw-W_O&XtBJ8&kv01h{$dp?j5kNTz0a(>UF_|Xi99ZY@Ffm8Z6!uzZhe` z9HL!p+z{#UHO|DwKN!5%E3ZTm!7R>WBlFZ=qPt;LY;=}%tn1)P<*1g29wmS`Sa*)2 z`&$;;zt!43JesmoLJg3LbC~3?P)5=s1(BSJV2?>4O3jgEQcgLcGFP^+%1uKNVio9a~Htm>extvH}u0HMUH7 z#~O0~Ola7V{b&xvZ>>OBQfFS!<@`(|iv&NSnB;*Z1)`Wk&gUiDkzQgtDW!MrHDWHi zos=veYL(b|I{8_0e_U4l;-BpNeBsZ#6gc>|P4}M&IRC%CqfX+6W&i(#g$EQb3(ABC zQ9+;#45~%VsFdwt<0imHNUN^ftISJ&b#nrLyOYNo<6&90Gts5)I(`?e`lNsY46D8-AZ0pGDLUZxe&f3c>udnx>tyYKGX=^!4$U0xh+qqQ7)T%(zGHvy)wGnlHv;2$>Ct_9K`VE#JeVAUonTs!{2XH_SdZC#r*4SBr!s@ zI#7pT&M;~QP=Zq!5_8Z9gw)@rb&U0BHGeeI6ld4vA!r4`0?@{SeBtOq@<m@pzw*K3S|0j7a zR*rul!gZ1qtTq@>M0XyjAKMruttS#RA^h1a2(7n<6X2dt*CkEOtq(}xzh0c2`Tpmy z9Z7M%X;*81STgNCTW?JN!TIpSo-y5Vox+g&GN~%`hz@PZJPNj0f2Wb`eX7SYeOPj0 z^{$PXo9w-2>*Vk4_4e|;?&O=X^&J{Gs>ZU@b(L#pm)UG|f8i5W3S+;x`Z&Xh&9vRg z95OVW^j=@inLg-zbKZHZy?c0Ci>(hg+Q6MGOj7%GL{1Lhgu2hV2LLsP-D*(0xhClDBo7E4U5FfAph{&;r`#s~kc0q-*We6u zRONyortcr!7Q)bAYK&1TOBkwsMDW!O%3Vr-)euS5`+Z2>KdR_KO?*T|T$Y5Gp3Kw{ zXiU=Ir__iPnlPTq;f@GL`b6V!OT-y=n0M-kFjt5aiu6A-QZYwCd0sGN;F0x@Mlv)g zZ_gE4{37}c5a%tBgzF7(|NGQ%d_plfy`n1j@13B)_Y%xkA53#cLA{?aICec?fFg>* zX~ilaoaHz~jPyCCcHxu-t?-9-9*%K^jjo?dH?%~^s^MJYg%b4lQ3l|I;T;kr0DFLO zhApB};V+`bn*#bkaDdnv&rXfc@6HEx#ME7!ex-Finc$QPrX4$B)vs8ry51QD!GGCr zCHMRQ0D!Cb{o79bPpvU#wtrN&bP{B&{=byuJA$_*X?Mi5IshUZUvRytm@M?UWo{0_ zA$bYs{^nv@6IesueS6KrEDe`=d|#S{n6cMb?T{g%0t)K^NfHPK~b3yk9mW3@hh{%C{ZG{i7-)5|hw zO3=S%pyRX`^+A@Mg^-FCAYl=Xer={N$f`ITBh`K^xJ)>9Ay^cSt)N(}6RklaMaP%L zFya<+4Ks-PTnVj+$5)PtN-D~rP?}`mh*(W57!wvp7{)em6x1lDq0*0IT`+O$py*_B zIxA>bjcUJKA6SsKf9TUbpYwBhodwRIbvogwnXI;8e~l!v3@gkqtNc>qZmg1aNOtt( z(x%addh(6_ZSwM7qo(ot1vpdJ^7JpO#`vEoB}{CL|C>>w6E_#}H&Ykc`HJwkY(R;o zO#wxWP*h#*kh0+?AS=W!lL))(>(xsX$9E<0XHIW#-)yU@)P#b*i&dx+f$omm+$}O4 zK;Xg&iV}y?X6TIXT@!afNmZ-B<{}zYQSxOwd8xgSiB?W9*3)`NvHoe(69>cjn`h{; z2z5BZWojvSL=zmEF zi`v;bEB_rc{Gu1Nuy!_aq!+a|a5fP(F|so@p_ewXHFGv6U}fT9{oj8$S_9f0d8s8Q z&J-yR#R7vSoe3Gl10w0=mpnp|xVLFxnuUa@!|PxLG1-`=V{L;^izJVbmFiD>xL@N!W}wUBYO&~d#9 zMSC;DO^E*xeQExL35WLJpG z2bEG19aRj9i&SW17RL2Ho|hoJRTK#qe;%zuh!|!F@fn3^=ak5g8YPV%4l$cismuXN zl+Q62zA{=cBl85#n|9n})?0p26Ef@Sei`mkX958yok@BqD^~C*=EKCwh(lwbjE(R^ ze2XA|4|42N?qeEaF=j&$m?AZXa}EL-64r;gr>INQ5T+o~BTR&&4oVWmsf%<8gCJUk zH4kzTrL78BldvHY4pt7D5+$ul1R-~ZVGyN+5$}hC82%MdEJBhLk}*c$6cXBfX3I_E z58}TkVi|-Fm!NS{hhxNnuEpWx0vCsz1f z+jwyz;iZtOBzkipAV#fzM1UfIeRSEPAPp+CB#}=}^-4^JMpXzU*e#JRtej89qp8WJ zD!r+g(5PH-e_+W<=k^r14-x}d>W|(isjH$qc?hR_hsQ(&Oq^JDa;V1T z4>T$RE@pq?MvO0bRpHv?>tly9Jhl$Q4(J=5UK;G@f1lkC?4>qN7nM@hb$MyZ6iuYS{o#H^=yZs?pF%%@e+A?q`9fYj|FZkgB-`l_Laq|n^ zP6o`N2aH$3`t3@_`u-?U>i~VMP%bHT9}_KC;{}8Ph2oG{U{d;of02$m7WxBe;F&? ze_ON$v7@@i)Jzy}qfBGx!ZKN^1<{d=L-QBQOF7~CZq7%YwxhNjI;EXyF$XtGJz~9c zidDR$c#GFF*78zOXq97<+}3QF>02L_Wle2GtNnv&gPaGKNM6=eq%k=>3f-2Z*lm)m z77^B#Uq#rJX@6pU7kP?eaag%GR@qMS*ME7Dszx>s(mm`sHnr|P)Ak|0fNlE5P|@=l zRT)=_n)%iv9-T0+rEj?MO34YtZvRX^zrm|zHn_IduR}poq4yFE}Ay0Jmr29CUko*`^Vm$1 z&>1v`*KUd``?91FMz_+$ImRf09E)LEmbfFahg=>rtaaBkkRD)jdti%WDV`-u?6&%S zFTBvlC0<=0_QjtWrq2Go6Rn^W$Pm52`OZ+OV96-*7hbo@qLu>>IhoO=2O>K({%d0N z>u^4QmQ%T_P?ZAtG zF;H-~BF;6uu~jEe4sLYK@7 zspA_%^dv*i0X-oQ>C$dzU)W|gn9^vbj-d#GfqLU^Zle~P_5)bJOa;r@1~zA%0a$HK z9H23CRZ#l&-G;caq-DUz<&99Cs_I>KB;KhspFb6wF3W>b$N9qbufPIz#L%&xf<>%j z6fp}EC0v5lJbE$!9&WtBpfR@j@y9XY+hnlx+JFX9`WP$_)L=I#-10Ci968witrt{< z8L3Aft&1j&94vQW6b#syj7JrDO#qeU;uU}W7%)@9Uc>jz7+TCq%;ValiMh(ZiXa^e zifKevs}jMoCGvz@;`hJWUU7km#c}z>$LNqQuSMWY+VF%d zk`AJe{Alr6*({y3)Y%=gm18YzdYjVZU$JFopET+T!v#j4G`3}=Rg@`8XgDXap6}di zxVc^BV_QSY8MEb#a^2FQ!+-)h7PsklPqgBSKFH%|KL&T2%!s_Mh27JN9jqQwpp>T;ZycN_q+b@SFfETGRp@mlj23BknV#qE z1j|6=1ZcSP^s{s(M@xj!eI+Y54Pd0|+{ z)eR$s&Pk@OU&5i?rU~C6Iyx5?g8sE!A}kJ= zkv$gfqzsq)phZ6?FYdi7dc=8^QgZ~;rSBq4$@yZu99&3jt(6=%koK;}A}AA_Wd9=+ zNA!I^AKuEHJuVN%?)5xyH-bVKq^1)9#X%e-6(`u9|7VxhSeGR>i%q$&KgBof_V%Mo zcB@mAxNXJ=6YA%1aJG*QJns_Ngh$iO{15hE&xrw3%7b|~Oy*np58d~L^4-lop!V|) zdG^sRoxB%*=5^_YvqJ%GcXq4ye9sB&_WfTOT+SEx*fV>K%mFPo<|h&PVWmy#z_bo} z$*c&XWitw?3T2*^^yr~w!;ZLGDo|^O9=a_8soreo;CRozI3s+&8At1OQ}rJ5{Ulkqs~= zV%+j%Z<_%oMDL5c61+>B*pUsn{fvt9^9(ACz|{A0OOJ?B?y(Bb90H#rI&6;AQHMwd zMJ$i427cQuandrZ*W#jbv*ZqZi9XsKZ?n#35M8z(FlTtQa z`rNBG0hLUV6K+|<{lofkyM?~oFDwPB9nFZ%e?9A5+m5Yy;J;&lji!85jQKG#z)F@U zQfX{IS^crCX1ulw(Vtu&52m79k_jCu3)Afy(bNad9_>+D17+kb_g&VI7C0T{6S}`K z{q%JBJX;#IyVs(7e@=?|_kO^i1M!T0n!MQLuGCYqCO&g(erO-P;4Ar#I_%opv$6Nk z%56zOH`M+(YDe!t3}@bIc70R91%XlYf;#!Hj3!!@aYBe4=yw77?{DLR5F)@}BW!bQ z=oGulc&w0`@0nrWEGIAJ73j|;;B_I;YjA^7AfHys zb+Udd>AQ$ka2^$BvCE3d=A` zGATNT&xI|;9HuP`Y{|B7<8?m+lRcjT1V%NT-icQmsX7?sEu`Pc0-8@b;EGk z1|IfVeJ}zEr_}YvBl-oG;J@W>P(DxS{R#7u)y5z z*mP7LSeV9xuGkYi`6|Os5u6lYW|)Ow`5NK-6PkFdkK%KXj~ZiC4tK|QI4Z6g9~*8H zbyi`vF#^B+3`_!SHMryLcqs|lIASdb?w$-lgka^RhNlgT`R$1AcVnC0*S}c6-=cV|a>X&{&tl-}0>WPb)}C-Pep* z+l(*LA53;ZkSEU{!o5x&e|i)<8{sJ!>(+?(bufcaE93#Tz_Ru^+U<7Ab*&@1-Hmv1 z)&OqrtHTgidDX(gvY53}_H}6U?lEQMK{U%ml|5%o*DG)u^P7ktgcB!QuZHYhhYoSd zWl>m&B%f7TS<4NN?n{&kkIeFBo%KewW%^ZvogKpO8h{{%H*PnDUkIW;%}@82V8@M0 zGHUeW`gl3=?O?Ic8Jg;c6avytL1ip6{&ABAln$$_y}eI}6-7JrkzTyuHZt;c782#d zTcXvJTgD8M&S1((q!YK+t4fF6_t8>+ov_S?=-sp-4JV+aj}6`Qqsh>Ys+T4lz0e+T zZ=vzGL+igjpQ+9KPN4?`b71ec2vV`y0%R+Mv;&_jCen~}c;M?&rHQ(JgYaXJCh#ff zcr+DvND@W2+kXqK=wQB1f&$6Ktd+(7#fP1?h?#+8Yh9?Bx1w>MGDQ~lk4pyD-dORz z@zJtwdO96ZTcHYGtTgas-=G|w5F3?L+2{TC`)EU0Rp#v;*hKYU+HZHj(zEFBI=Qoq z%e;|r9sHf4Ns*J$2KJ#Z(cj6>v{}HPG%pAbb`tKuLbDC3NMImBeQCNW^JHS%A<7{C zC+O?x;zdx@p~u~2ayU6NqM`$Xyz|g8u5e{EYZf1U!-H^e$z_E*fv{F0+nr&6-rRpu;E-2S)l5hP89+H`4$IaI*)XL-J4nN^)Izp8^mS^C% zlWk+1R8^^Dq?EG>j4nXto`pK8qbfm9bj3=ZwJCXed}xD{dbjUXm-LZ0!RI+svneUA z=y64yuP1BxsBb_y6pIR~SM_Y7%JX-Z zV!%+pzO6-w^|mD;TlN>CrKBiFOw{yZp>gZwJiRETM?oY$6*D)V?gy>0WD=bxG_K%D z2@%R6)ohWO{*WGzV9UVeIDR%ddZ&>}=d6bDe3NR=!Zm>lXjqTnXO(3`w%W_C`j8Ov z>HfN5MKmc^G5Y4RMM#SkM8oW?@ zE@MG9AlAAr@$v$;f)f`)=?FpY3sBGYXWvBs*{L}WSu9=N5cxpWVpN{WP)LWpP{LQ2D_S~|Az!twj0vXeDuM>LM1aSObc;A}N zXzb&&`DI`U$<9pLP)*J33Lb7H>v}ZKQ%PmrfgVy@ffQx#1MwqdNx4;wfY7=bI8Q95 zGWG3Fiswi7Ykq~CUGp1>1Bd|i-ETFLF*TK$tFqu#)5>(?5RYII4|tL70iA(Ae(o!} zomplgPk48|h>_5)|5gG0Z?KPlV1cak_2U%kWWQg1CwfD` z{Tj3Z*aW~|{%!LA)lmO`Ew3^%Gyg-@Unj{*9$5`##16t*SV>bOfLYkhP7kdFp)3XQ zQaLgr4A>m?mNAMgjx;=ID@{ilAYa)#UWZs7@9Gvw2)2y$cMHYQuaEqB1x&r{<|`P% zYNg6w8y1z@%@?7z`|4(%t|!+y%w{j&Gwr>cR0w!*%2Z2IobBx}Q-}6;#U#~+)+PGZ z*-i4AgI18?07&Ht`e~01nh}ubO;jG~s=U>(ehoU`*YyYZc7sF!%1iWMD=BXj(jO7` zX!TkjnhXTydf*uhc|h?5P=i3cZSZ)Ni!&`_42(m{E#U>6)N1X6aS8X&mczPdbs4lc z+6f5_ER1a>11ex`+vQ682UX!<3i*I6oKOlf@>7SQtA4jHU&6wjq(hY`c8b>6SFvz^(pc!Qhh}v z5E>ByXfciSaYY+PTjjHUG5{5p=z4l$s^oy&AyZfpAvE-i)}`Q zp>fP`V-HZs2e%!p=#6+V*>=y_#J4Y(UuM`LPo-UApG95Y@Y#`WSL;%{(MzhtdbKn3 zxENR;76?OZ33BXs$TyL5Wz>JD)ud5$shcUG#)GN)X|9GoKQ^SoSkoe1Q!~J~vWxU$ zhTg42RcWwENrDf%I1X z8s^&0Q$wYJH5TLr4%WUNDMapvqELPtBt`9waD#*XFwnM%LraeMw(~gKc1LG9!n~^RBmp^xw)i?Qr9M%qbyWyfZW7nY&Qd?d8cI6Uk z^@9A0yL;G+(fh}*YevfVu==vbA~)~{l1!{)I(GQ0%TRQgDm1M9GD0-BGxE~gu*&l~ zpHqG1w_@r%22w8QQrRxk^4S3{u(2CyZ)n88PsPOXMCU|ULrou5ukU#yb*aRgj*!D7d=s*wh zb|#eIj^DT=-aMsy*1$V+Kx=GQRiA-d;EbX|Z|yh2oCVDu_0uc-{dk13(>(A=HwW0_@JyFkXI1(NyNgOz!HzJMI|U>?Bp{-Qw>&gePsQn-LUo(%lk&3z#4ynL9o#7yc{@d65(?!G6dhN40r}ZS1{cp3GEz#75ioGjVClQb{L3x?HYQ)E ziuF7h8G{2ANNZz&PLAKvs@U!pP#-y(L$-<}Bh<(mE=1Us>O<$vP|+ze^JPzG>k@$0 z){YS=tYxg_G`*H6k|JHI@qf-$AfaF@rBv(oCQ^qQpckodv6CA#^5>~m%at@#E9L9P zxOCpZ{r$Oo6n|?bqNI±)#GQdt1=ew5IuBjIwhQW07EJ~q4ocF^EvmMzyoLg{!% zC}Q9Gm4C?~R4*3|Q8W6!8u_a;ut8@=`$SC*^w$Tk8q#2CMGWar)T6G7S|g_f6dOv? z;7$xS1bcJ6?S;O1AYDYC)s+S$>-Grw+cz=%a@T&fyWxpfPa?2H|02>Q`$n4i6Dw6B zffX8!af~-z;5R{M+@S~30Sf%WVN-bv3f($h=})_&Zb+4v;9X9}w>c+&BOfVO7Q@zx+pl_!>af$RK=8U3|ocf~%RYi#kduQl8<*MmTfN83lxR zx611l_jG7y= z7nUd2d-;RTMeAyM29EwTnF&STD#!|_KXMJrYYTke=ffbUEz@KChV)VJn`z>hbZ>6G zJi6SFoOPfRCb{)Ucn=x0J)e#*ezd@T+?_ee{l^?WRK6VjAXfU&tX$0fpuOgiju`e6 zJvLUR;`k_&&Y2tdb$=Sz=%%`(+7%W1E1wIm!`CA$<2eXA=*n3B%;m^|A)EOkCd+0N z@<5$UXs2WaB}Ip8Y0aiJtuX{W42pjjk!Gj0j02d6yAh%lHdP~rp@os41|xtmAH`;W zo-YqJ%CfqYl-1>9UrQnF*JAi`Tb5)AUp|YhAeBIrC$9{Pt@J#(Ih#CUeD_KtX5*5o zVez@nbGMB~C(9b92P8AS*EF%`Cje3u%n*D35&6$H1Z{LrO;5F&{wnIM*`?Guv8c~v zIj3K{k(So|c+g_?#_4g>p(ZG+jlruJqfYoUPl$V5r;$|)mB03SaXHJ}MN6%erUYFZ zKJdJGs>&Tf?Q4m-~-sX5-e{JkLaG--plvYCp~X=Py!q;?>A4 zRvR%;h{Dnc_B3h^OdI;1S;c#-ty|PgB|^M(2`F$>ssii&+GKRZbQK#m+-C}7e3nVM`4zg`p}yTDJZu+Q6VTg9RHxbZEON1LTKZl)&yU z-~{}KF7}&=wH@Fwtn)ehWNtd!2v-q}w9wWF>giAG&xz8S+309mPRyv!qrM=!LBu=S zbkV-wo-dz~Gfe+1_*a9 zb9^L6?0qvwioBI3xT#n?NeM7F*fO28QQKO16p8*2@OX@##`psGqVJK_YM(s}S z%oMEi7n>^)N0g|$+whulOm#T!iubVyniWV|+VFzpEAMjpuJ;@}5splHw#*QCun-4& z3JKjX>W-HeZh3S;1@^>{YB(WH1t4%`H!A&#qMOpGg*OETNr&eu$SyRVK`^yKd}A6| z5_7w;)u&UFhMz$)=_A-TfoSjXh_TvWq%6t4Se}e&R7@GrQ2`x%VIEBPC{QBU63vFR znKNdl95&Oyr-qI5mUMMJJ~s;ZKG$QW;ewQM4cs2`I+qUa0?$kO3pKoL;R<(VvGHwX zZ8q5zP}5Y!Qu*@I?TGJY1eV+rLrc%74D62tL{Kn>M2@)~p7_9J2k>6L?HU$#B_Xr)H2@~cto2;!dAfai?;0Q7K%Q-i7E&ei;l<(W+VR^t)7J{Ov~N7O z#v7 z%Wb78+{61Nu{Yh`P8WgEjAIhfl=YwT-OmDjVD%fw(-}mE){9Q+ za&Q`T%r8}*3Lp(qIDqfpbOz%cLgXfOzD#uU)W?{K8GKFKs9S*Lsjv_Vh?Io>##c-_ zFb7JG4gxW@9bl9*mkrJ9g2ee6`A{`;6toQpT7u+6W?wjxZh@t!kcW=T5i+&Xq{|rN z-{L-pEXVQ~qD!c#1yP?^we@AMtI~j6teC*tQFE_dl5f*bJY!K+aHM?e2c$bs)+9{eZ#JH(a38X72T~>6^;@2 zui&@59!?n`G2G?`2o`S-)4^Nuix+!VIWxHhCi`j9YDit5ZqkpMmRzSHSJ9Lc0Jw9q zYdp1j(>ilKBgsOU@`XH?!=>J?J|)1ZBThI?TTCh^8OFFb-3$Q-Con|_&$pYd&*+29 zBD}YWvYIkh^CQAim8d9|iB1&bLXXjIkNhbcSgm=i;`Sph&w=^VRvj;g@N9V;J&?15 z2j0s>#Dr9-A_0zK+|aQPL`ZF7YyV2e>_X~!j0;X_$IO{ITiOQZjUhYPWAi5ghcsuL z{dV12j+lRdy(s~D3v%UUQk0Q*n_HC@7p$1??*Y0`b_p8ZYwLre)SPTZ^Ms07gT@q1 zs-sqiGf11ya#Y{=FEH|-xcL7zn*WE@?SD75G5wEtkCi?EkVpt5^wuHd{)ks}s0oE1PM|YKh?O6i>O5YtAb>8-}a~x^a zHcm-6-mS9ksAp?sWb1i74Ms?m4}=^Ru>B(;K362_}=nw6MFRg|&}m>e(5MJqQchV-Y*bA=r z*=Fx&H$}(otRF7^j1>`Tm`+eb|7*)w$q()cfA-5dx$aebF)+Vd#6S%#?f*RZVGvYb zuS2h@=Nng>q%0O9(meQ|(^a)6Dj*f$Nj^%&PkHQ9m9UId>YH-v5xh`yt z#D7#+ zsh`ClX3gA+x)pFUoXve{W##w$Ult_-4E2DPXhuyGFWd<1C(T#pw5C8 zG-BwW&Xek|gYrf8rgJBG7Z%Ts{o4elWyF+EibmQGiiyUC<`@M&7#I99h@2`#8y9XZ z(qgFPfYl3E*P6LuBpi3dYxbRyjA%msXvoiGOo7zcw$oY$wyF z^quxZfAiZF6C=YDfLsP1jepl8OzXkOV5xs4R>U8PwQLk`jlk}{wLf)i{h(IqKE7Gd z6KXmSgDc2yQfX}z_Kcaze|>kCF_abh%Vr2?UC%}ajAm=pp`!p)bS1zBriY)mLSQ8C zuRuceFF`h<;2`PYjTN-r^G$p1`&}9!zF){i zYBq#(7h~X+8vbHWqmf;|FC|!x%hDT)f}pWRoZZ>uFLCk zojt}f3cXjUU8#+1-ZIZ_9mOm$&gX&UTJnAOLu|rgaF(lk>!Nb7N2PJ@{0_i2JU!e$2;b!=Nbq~#XX5gvDIs38C|`3se}?PN zkgwt4>e8r2RtD8Fp+=+0UvaEw^jl>UR)%^k+kVKYGn*t;hShD#j2}hp?))%a8@9Sl zHCF)}aED;(5I`jHXrI{OM;+JE;e|UXoS5VYpgZ~|r8Z_AeyqFFslxEWRvSH~`Zc?` z{NRkD1ow*7|JSaPkn0K0_a|gl$*>>Fn0-B>V zf9^=83!NOI%s8*YzyL`PsKFEhL{j>%iajE;yA=;#uHf06EHhR+o;y3FbkN2Ag?U_n zTK58$3E0|w(Hi0U#$PKJqT`}Ijf5SNB1r|RBQh7InQ9?wljj>C8`5mgiaW(gJ3>`HrTWw zPaTf{slePaJ-(lJjPvOqSnJ*r=Gb=u#qPW)w& z`%5zlAT>11Yyx<6UcvAzlP^AOZ#Y9XjKU1&z>pl-N!JTpeTb{C7uA(RRu8m!0osDg z(D5C!R&2hMsPce<%DZSrC0^LtacdE)4-^;pLWZ;&^~@!IzkN@68COjfcf2>THztUq zi61z~WJ-!dBPe0W!S>i|K>y5yu7KBVMOD%=+6yMQbsu>o@1Z?@6Zl9X()dqb8l!_{_jERQA=rO3r{OX7@_EezAJh7D}S8AAx}(`DpV{z+*J{|V`> zYIxUZ%o88$xr=(UMXaGMxZAnrW^|@X3vCHi2Wg@(MC)``+q>h)`+McqgW_WreMJ-> zQhSV;CtBnvxM0T{=CAhUzN9T$mNI_wuJDSiGN%Pt75@|jVdjjX|ui3h|cLG&iM8KW^W0a== z^;cMt82n|VfF)v1dAI}wF>z#(SWVCYVc>o}(xYFW; z!d8*0d@$%~FLjk6c~YSgfB@3xC`mvv2N>>EczL1-cKx-#X4%z%)fje zZ)*adzE3;#4dP$a&Zx#Feiy=2LNq$%E9Xm|%7S5e6;!Lcs8@-d5d_pAQ(gSAG?pqo zztCU__+4p|DTyMGyJc9yGx#&f^|%gPch2!>Db>tI!p`**YAAmbW@%APVKK09ml|?G z>=joi3a!0>7X-aQ$#_MW6m9r~mIlqqLHAT_liA58u8>jtbTR`6;~JEXIUp`OvV1(h z;v^5oDhK0;@Z)_IbFU&!emkr7x3Qy&^CQO(yG5s-zM~696wNTx0*i6fjzLUwuI4_E zwvRzwQO){2-ndD?4H1~;A+1H`+Kgpk+m!jAuY$=#NeC)rYMcEhJAhv-f@H+@=%|BH zaY>{r-ooq?+gg?YW7yhSE=pF5jmEj`=iE?nG6T2hJa|m`{Rz>9E2D3n?TL{&c0sH4 z$2R0P>?1krni4B^JCLh#2K0OhldmP>4NoRq<<#V*0os~LrpvLbH9OWZ)-V+&udGZa zNyEtqkd+Y)m zcEzUL zb+55T%XjFE_fOw{3yyW}BAw?KmzQhe1B76-gMM9)u2-l%VqaJy{p@1KvH1M2=Aa++ zD-c!(o)aI-or!H>f8R^*U@uSx!GSmAy>lO6|8#b9JGV%Ddvt%`Jx*V$9l1H%EvrqQ zE)NU9(X-gftHdRAbxwy_euN@b_P{E+HxkISA%(fZNDaZcimXtIGVz zaYy4)Fe;MlNh1WaIrL3f7FGuTcxWaqW^$g}eb5Bf+oUH@^SOuDZuc;IB`5z;-;n(R z>1mbVz>FnJf9Xy!3LHUmlg#blq6I<;UKF`F31KyMk@m2+msUPcZ5lZ1?eKnPl!0M@ zYx}xF%r4-z2+h2HsQk`)Np&p@nmR3cO$=1Zg(2E^Owi0qtsq{q)1ICwt;;rFQZ=tu z*Tzf+2&BAi(Ujpq_D`#DGJ!N!_BNEHiU}pOLPQThj=^Wk5df#%&G<{|`y73~TF(}S z!NjGCX!C)y6mfaET*($&){2InkWl|je5se$ zxjqasDPdn6c8Jx&p5nJGgo2Qmm@{p1$>gl$F=T#StoWjn&=*~AM(^&q@x&?L`ZVEV z(^@R!N5=lX4>%NIEV}HMY>>w&BkVrvA)BHrht4V}W6$A`o8@}$rRs2R6wBdyXyL^# zN?a-N60TR%)|NJ}AiA{_XhA5#^Zac{FEEEtdJPDt=P**_eZo?PC4>*U92q^OYDGl4 zM6oEAtZVWI)}GW|G*dK(?u^Wt7dJV*NWn}YgrF+=AohTDe_X1Q8@?wDS>g3IX`WlX z_7~rv;?s>PD>Jl|{FS;6qaT@LrG8F->81P-@%lB~-67I$>90gS-hrOm zCdZgQ)ygb=h^X9~Fp$o?d+uZPpQ#057T}J1Qdgu*ptJ!Md!B5#ob!YbB<0A^*<2pH z1pfX%>F{EH3-<`I>Vb~ZC#t6VrRiJSytt*MgK|LN-d|A9g5P6=fcSNZd!s{m^>g%d zZ+OPCt;5(Hk~tRS6;AVPlOr96_7KRf2-=oJTKyN5K~D#n#HgPYLEy!7E7C2{>*o@g zTWGZzJ(F&?71*nca(t^OwnZLoq{&pgJ!C(>f3|PUqk8Qykcq2 zy11l@&RxH3M!FJ6-Ap^ZcR3SF;39vV+dSOi@X{7e-)^|kcoCj8xV#d&%si|hW}M7q zI3b4|4ErNGja*=rM(2s#@Vy6|)k0q4Shz)^zP&G)14y+x0@h+XfBFvXx4}(-XlubM7u6kk&aQd9E zmnCec^z&rohn0e!nd?Xu97F!pf>btQoNlB$@wB{UR;D(p9c%)D<(cTi`GMep}YNV9@K{CE%Ks9*e4j?x1SccwmdlOFGO|5^jOCRpTp( zU%7KIC%F7|W@-Ltd=|*b6`a}=O0{#kmHaXaEIDxY4)hzBowU^*|>k+X~oR) z_y+2)(jz`d7~{tCD`?~VEIwR$QG1c|<_eF%V9)u~cHI3&!-}eJnNnLAjt}Wgxlbuw zm?Km}kjpciLvK-#2T1i|2#&HA(w3Hn>2Yjue&AY+u)8^V2PG&=wjC~*S;CH4VM*w& zFYPX@h!Jkp3Bi}{RGob{4~mviN&cjxTSq+kyHBA5X2fMkl#t}IO(_c0tSzo8`e zjW$F2JF302TVG*)w^X^6W}C!MeDCwb7{li`HxQBUMz`xcq^xY4F0rnKJ{QcPyA9@z zo#C@fpby#s)!yd0I1G8a%KX5)e3R(a0+Z;tL^?IdFKA>=68wHB8DF=yu({18FUuR4 z3dIsRW8Jlk!waMrP1!+Gdw6~32Ij7>x)|3L3NB`pL0Ai>D4r4!Qziv zL;Jwtll%4XRI+ua#G84PEHT9@kSm7jAI${zmx(z}xrK`{<)s0A1+=q8w&)EYozHrf zvTKV_I`>fcFs*^L!b{Prr<&@I)A!dn=@!}?oMya(HFM8>^Fw9l1eID2P_i<4JLc_bm;+wGdGq)ayoF=KEOmp zKX1f)vtEx_t5s`?&~9Ylqp^|86|i{%BddUvRpO(2qj~BZdQ-mzReZVtHLAn}REbJW z8TPsiq17BJ9N)+Qt70i%v+9pZH>!hDT|0VP`u61!pI_^1$8FICPze|BMNDzfbfT#_ zi-}3IDs*#+iE1r4d<8W{IR4KU^-{4Q?gVeU%AD9|BKaS>Q4aAy6hq@0DheeA14I5} zGNy2s5l%IzhZ?3P+aMsQ&M1#ob{Q5_1>bN?5i-ECp|F7h?GF%NQ8%(rmKxnKXF^a`vAxO&>vEM5F| zYT7_eWcLQ~*ruOXL>wTd@w7G&Shxp9oxhs8B^{lAClu$>>v`43C>1$5yiwr z(cibU912>%VnD^zq-?eH+^nji1Ag7D2qyO^fTiF>w|AEWduD2Lrv7W$bQ=tY;r8$? zst7jNKlvP35+2q2(}RUz9Jy3AV3pdXe*ldUN$^wu&50a0wuL)=fkVp&X{MVuvGCv_ zUNSzWoD?)NWi1}8`O$$#QD5`Zf0T$)G55<97(zm<3ax#+@J#)S1KeTz!oEq)2H6gx zfOvaU{l`dIj1M5tVi=xjnFoh2I|5pbP*oMP_4~wJ43}TWhD)(q*lS(kd29u!IU12( zzD^ni0myj)zpMaew+sW0cQdz$sm{Gv&-%KBcC&n4zs^Cg(BCeKuGSrWcJ6cZ*?ppI z=*fU;)JpqXgjrnjHkY8H(zp$+R-g3I&#9q`(d`D8#23Aw`JFII3|&K3f(&rwt6jV3vk2=8a;R% zK;byJ9@w06c~Z_+AEz#jWtlYuH5tYIV-&AJtm5CrmHfvrNs)X7wE)pLQn5C1$=pSa z#Bslw$b(QE+<1pmKi`AuyeE1M8nJX`ZPMS25ZKMF2TjDxgaW!8$wt%w40x#H7COu7 zvUeWlbjsD1ggt{lE(+Zdb6b4L15xl2!ZOq%$katwm?fiHk;3?iA~}Y}phsL+pR1-5 zH2I;7FhCLIuyz6Lq4`m=lPBLlfEW>F#LRLDsyy&1TRWH92gL47ITgqJOwLQEpS;S< z8e?mCGr1RzytOygtqKDpAFjCb=B1-^n?5s{T1lEJ_R3L+xg8{dOD82m@GmEP_8esP$=C|UoGwmN{&J6JyC9?~@_LpV$3k%(MnC%S{6w)ha2~gz%wkm&g z2f8#s{)@>kJNWnL+x{K&9BSV9tv~k@L1PmAXbpjiM??h+1=y4p@tTq{OgB5lt79Mu zj`@;O`DOXpj6Cv@-YslF)fRv!-8jU_h5h-q*_lx)kR8&YJoF6Io@A2PEP$y|i*Gzx zKd!X!l^%0P?~;DHn%GZa6nsKygTR$D$1|_c)*q;>QN|aiVqDCly!&n?V;g~@ct>r? zwUg%bEFZAOMfbD`nARjg-3My+6x$_rds=%HnA7;g%8}b{06E@*bCX2}_UE8w1tl&sj zql|{eNm{6A6Yye|z0JzeDIHZVE{t86DL(NVyqjU(?lO$D(+I4C%#&E$H!LIDQ_uh< zi!j-Ewe+M_#n8osC6Iw~HoN2WEO^~&BSWRyK?|u@$XQ0ZIk5c$u=|zdYQy5OLD#bA zoIJ_IxQMBto>7ESuV^PHm_57&p~4FmWE%e2h^21pGE8RX0|N~iD{n7}B~Ouku`u&S zq`B&)UT_^{dyNUz>9l0z)@|_5g*~hpzHo-d=>o~o$E)&l?0od= z8toiml!d&e)0xQD0BO{R*m2#u#vCy{0he2Ve@5D1RY!Xh$?|&Ou(NqlEu5X=g+w7( z0X1v{F@lDFzb%Ezg9iCK4rzBg{rqkMn##$W2f5?$IG+Zr;FHzKBa}o*L6RJ0)Mc1z zqyZ)(NCp$=Q4Zv8TXeWpv0=~Klqke`EastgTZHVEZUL;03fz)d3I7)0OmcSzBtc?Ckou!R%lhX!gcrhI?9z1pcZh z-S)j(WBGDW55x$j+{Qi56B3i&%aewQB`kimFS2BoMfi5B(&M#ims?6h*LtwC1PYra zMRfHmbn}KYpJq+9X%c1`D`abyfE{~PBI@{+ZIdiVsfGXSp?u`e-wG?%D>jMm-V86j zf_$L=rA4P)#;OUVd~yS3vgAPGh<<|~Kz?_CCMBa87Vg9En`e}~OTnXC z{#XBpOS00yx~p(6;mA32R01ZTk}kVy=Hqh0l(Wa{CN3qHG^63~SzG7GHLtFzBr`Mv z{QF3sG5hnA0#JLww-Mt-(1GDQesc5d?qOhSN>;OA$qHb8gj(!(dB|#YA^gZO=q#7J zc29e4!S&Ano5-5yuxt7KtFqBN7X7#DoAuZ3qDJPorwU)}8IKobs6OLs>zt2Gk+-cK z1nk7*a>Q9~N@k$P%YV0LJ$KFPf>m=VR711ouj1`)sH#pWn^M`5iE-)c-$y;_DlG8- zwj=(JEWrQ1e`fywyH4X7>gj*JJooxCZhwA0M*%>iVTJ)X0X{PztN+_2|6y(Yzb>L# zSQ!3C${|D@QeA1Sm5-4GoEGc^Ve53=DNscrdEnw@byrmcP|5)Wm317Yv~ao!f&vVf z8w3;7L={0$z_>iyux7bn)w1eY!{#QxRi$eC!TNJGBI~oK3)u3eY0u}KFR^}ZV%O^C z`5(>YH9;N?Em@eT;YG8R%Tr2!nFd{K?R-Y_F+Pk#!5dV=fk-T(TUa>`>87}_1~k`_ zl-J6HF*$TEkK#4myg}pzN<<>DdgfLy796`u;y9~jz_QU}pSg+>g*P%$K6P1LQlg^V z3q`zqEQ)4P6g;H61~x)6TwFZo=J=4w&B0mPQd?NvJrDsL9%C7o{)ivl(VYvc~W}ksg^N&gPS-aFxTI}zFDK3s`y0o}|MPNIn zhT(^G;J&~SQj+v)d`iUP`nk?V1-FMa#zz^APT8DpKbgfb!zKmy2jU|B0Vvjt=t*TD z@0dX~jOB^hz4C^1%=Y>{^Q8f|9kCB~T-|^yscb?JPNoUeJ+aOw8lWl;(3oqMCc)jzyFnysjBpX2S6)l2?2&kL~T1WxWjHsTrf_6wdo zL)T$@f>Qcyd~#fiPzeE`mph{DAW4M;_*Ba4na(hMvb}(cpXW>Fe<02G zp@4C2sS*apPS=H2T-E2TFE~e#Rt7lh42*lgVd?{uF)#PXtB>+ycQ{Xr>r~pM`LoFQ zRD4f@`Oiw~suvY4raV*h*P8c$kPCP}kle9WWR`Jq)hSSscN39D+s!1ewnuq^HrC#~ z<+(thg9h8~!6%Va0zM>?vjK(WR|y%B`0DBn3-PJ-fW-%n>dlBTy1dEW_syTUwfjt^ z3^hMxA7hZqBr-h;i>0h#K-GS$LII%O9+mr8-H5u@w;@0;{_oYbO&7A7NY%)Kmi zZAIbEP`emM(nffIK6m2~qybE{N_6#RnfWTToRVD2bNBbjT4}UL7+cnj5K9|KecyMb z?F0L8fu@Lb0rd#%1Je3M9D%iq>veESt|9H9At2!4AoFy}vVs>) zUzE*^m2oRNa{Iev{1pd6jaeX1A@%8tp{I$JFj%Nq9j8e}=SHX0d5||hPF|&e(e8no zEsvvIK{)LB_?1V?*qM=&y9Z*)7$p78bQghIhiF1{{eUc*9_A4=qv!Y zzWIYz<`f;kDJ@i>CMBk3HY$(U$ZBGrj2m?Dy1xM7zaKgkm)EPi8h<$U@H$&3b4Hxb zWJix0F44i$!JE8%>yFI=B_odTEb|#vAJGZ8W_0n`!H+?MtsC0sXO4CO5}|d zDdIv~{_$KyEL|wr{kYu>!xKl4!&e(uM!&F#{r=$4GQ+q~{T41GH-V@VhZ~7f9O#?= z$cU>zHS>AXEjCtV$2-8*1xzSiprDk<>@OM-yCht9d&r!z-2r}Mruiubh|F9N`)uFO zT8aH_`hEO;IBLE+Ty&wC9hzOo13!vk0Oc0i_~+6;i+yCAF*Ax7`N)t8YvkA1oMfang7d5s zU|v_}Hy%Iuj%wtpR4xJaf{x-Gr6TKn4cZ2#k^bA~D-q6}-5bZ>T*uZot)G#V)Fo7A zI66G6Qp(1nta^K9e=L1M*6a-Tuec;5hz^fCly0{-Ce`*(kc~wZvs5RDT)zsor^k$6 z5EUmnl|2ZCmKecg9={sE$qRy@xt-_`GLZYaz)#C***EmIGG3St{_kW4_#D)sgBvU? zn`r&Q)OZgei@5EJ&!T2lv;WXDahiCMLH~0=F^;U%0aH5_{{9l2v0ECS$va7fIlo}P z;~#a-3h#O6uCc=?1V66Fq4y1 zl96WC{kA-F@(}Tm^-R8Vw#urCU z3M|-VghHdSO6L?)=UsB?4n)HX(RP-Zg#0OSOsANa%7yy*2mSN@(VX$xjpSv~HI%zr ziv2=S;Sqcp$c%FfzUVFu(yD8`#dc??ajN{In-KIsVn5d8Og?eD7zSfPd$kjESF4{R zj&4agF@)FKD_Pw{9{J{{V7hN&#GJ1<3bxNVRy9(-SCk4rL!=uFB6$%*({rW#_f9vK zd+M{@mo2~Dmyb^@->EA$iEePzcSQEdnOq04NNh)x43J|7%F{;{94O#HSbb0v@nAU8 z0RnK`e^okfGI7smJ8T`Lw1;Y)dEZPBe*bn{PqC|<#q9OHV!k@8jR2diKjw+`?M%3J zE8V4rMT%27;7{A91rpV#M2ZngLQ zF+-GVjm?9n)NChQ{@vtj?eem6$JN6Q@McTw-4$mmYlr?2l?HZBZ-PK%PGPXze0Aqz zXSsz`jKIYsaBUBRkN}sf2OHTJ1%^-6>o>>amQ@ej9b^ti4C2#2+4o1IVXGq6rS{k1 z-X^i(ZhUOe8)i}jvpU42tr#m^IKj*9w!b-D2C0pkPw<5LMDQKID`TQ5!(6Mr%YAKi zYuLZri`yY?b<#TPkO`8tJ#3szD9{8wU@=Nlv0+eFw%5rahq_vi!lxZ$8y@sHN-h@D zN+K2DjgMsGQ0ma?!*)=J$;Af`tTDM(%W$);(*Fi$fEEo%-s)P@U$3FsvYnQNhLMpX zCBx(<*Qe)3#q-06L;9ID_!yLvs@gbIG}>rNy22AbAZMU5`08Sie53_`+M+{OTED*e zsK!aw>PP{{w%&@|xuZeVy^S(EP*9&NDLXqkDQ}c~9!c2|qpIRK1jxA>xN=(w$Mv=b zt@{l@h*FRPkbOc3Fr=nPw>WfM`15{{S?XdtaMgpv5x+2v%Ja+VKE*YgH9<8UGV)Xc zoc|UgL}{T=nV))GTAI2k>o}|*J_m7*c!4+Z4t~eE(K@wX2XgU+O}B!RyGR2~cW?Wx zzT$MZO|J(px*zeZ?F~ruW5U0wGdILNghs?oZ|8;9HlerLHQ8iL++Y=DCjG#3t(G$G$1EwQo+%?|1?yMa;JtZB<0lqw$d)#^#l-)|%csJuXHBU6h zB{glmJECsRjcHcs=6gLUG;dgQ~xu4e24yYeKFms~zpD`qx=G%3$H5tN@! zyfbutQggWVB9Wtrn@QqE{A?1rL5_5MP<8PWn6zmftj<_$unl>H0@qM3;q6CKuwCro zGrfg-%M&aOJ*!d7`sy!gKljEd;W#T$G-5hS6a!F@oqdtE5B2>++L){kBf9!4AFpsQm1 zk%K1fV7=%ymxX%Iyf1q}t)92~z0LC=a_J)+ovu&B+41Bb6E zVd|AhwB}VzbOA}&hiG$8z}${V>cRo)+rHE~e(Y2)x;XYSIA^{LjT4Fcsy!7j%Q3u! zF-L|ug^e}7z>f9YHzI6`026G6Kz@EU*a0K=&ydWjw}Ws_z$=3kUx)%?; zjgJr@Qr3S@FoMaVTR62vI`jhkaLaeqzNDO$q%c=ud(Bo?Zxyr=%oI}>QrnL8u!t&m<9HNy?@17Igp`aogDge3)u#^9y_AviPq~ZUn_OP?E{Er%k7*9w6WVN*y z;c*aD115y7Yg(LYiW3>o#h0t**`+=mlz_pzoTVA$IMqIM!Az zYH!FoBBMVxdP(40pPwF{A)Z=OytcT!Zt7v-9~FZ)J}8b42o31xT3lY9p_^1DPyt(y zl@3tPPY_RA_Sksb`_cwgFRo0wY`0X+w7fj(7hQ|?`0Dl<=(jkXtZjz6yRCgvCgV*W zPbr6dPA5_M9=j*9>pcQ|k_JyP>#~e~SIPb*G;w#eyDY9YJ0`_TYTC37y7r_l4$v{! zUj3?G-tWmeh{lQIiTG(0pv5*6lPV~el`XkggFGWVGcqM+3Qd)q$~%^MEcu?HTKqM| zX$#Smq{`JQN|vpbnJ!%{L0b|%gEU1p6sjs%mo+DIHN|Sma45tqfm;$B3)%irE3zuu zDrlEgCo?uhZOXLEahGK$Q#M6z3brZSEa^`KJrqAF=_j)uO1>!ksQjUd1IzU#Wkci( zk^`ZNl9fSFB}6h1sT1>Tmf4DUXDTo*f5Wpy^kBD`uMg|AT+tHCP}`3W&Fr>2_XJwzTL&W$-vVd?Hs+(CeEHpZm^3&{Yb_ z+^@Xcr=-PgQ&NjjM$huAkL~$VM~Z?i?-64((Z|8Y?sT!>;x20tt5Uo@nbP93voXk_ zEsv?^=bTM=_clupecC(qhUxuo zhirPDIe~{U(!~q9Wi~7Kjd+oq8WRyfByH_Jf#i0$WAt#9k(KmTwdV_j-nn#K$QDyl z??A7`(1F(M-EFY&dYn?DCF=dw?$2WXcDFKzYoMxou^mBdX-~B!p#GAoJRp7+At)i; z9F3AU$mWLaUVK#omzp@K1`>PI(#FxoNr=lztP*+1n@4BLNK;Y79!VZ5v-(Vkggzxt(TrYL~_-3R+qFYnu03aWD+$$MPg5ztZXu_4 zp89L;=|6)Io4-=vEw2x(H_Q55DRhnj%BV}MHz^12AbtH3He`p~!0E zvN2L}*0KU`7E_NXoF)2G@y;QkmBJY-nB3$(Y|FS_eKFp3x&sy0j)J?~svZDa0@#m* z8Xvd9JAGsJRP}7NE#zLos)54RfF&(q`Zjq=H{tEBfsc`5)yyn3QAU+C40Oc|#W4nx zKyqr^G$2hP(7g?MK-}Z2@r6dpu=u7Oe1^*-%jB+es-+xDjoEr@frOOtm)vC-tVf@_d~8piMF$+K!ZteRR$t=W|omF8dRgPps| zw!7kx^@lABec0^+d}?u$0d;%-2BLLXqnZ6)eYzV6OPD)F5HQcSP&|&s`PI-n*2lhR z%sOUW<{g+^Hu2}rJ%_zA7^pi-1)S-bC6m(v^|Bqt`wFxO3k6Cl4QmbOk$^n<0S3nm zUHK~!co=z!WK__!;(Bw&>0xBV7jHaz6K$J1F7G=C9*gul1Zx9ENOYbr8=lPJXBxq8 zUf4rA9z-pBpZw1NMv9sO#M4deYlFWW)MT<01n1b3RS8+~Qop2B_duN^drjW-Q6f#I zMxjQHcj;oxepg((%Zt(JGJM@16rDn8>==M8HLXY&DoTUz4hR#gP=J0OlgzFpK0-eLQ{=z~+1d`s4ae`TFTT1YLBP@DE8fL0!cH_Xc3RW+w(ezpo3`#}j$i!SlCznEJnM5*egwFs#4AQqzVmsbe2Kg1AGd_zjxE=9v2Mqqlb7qjzO+_(1UdKjHXORm@SoV(A|f&FN{P(DN5 z2qJyG7q@=Dd@#|Hz5OCVVQfm4D`W#igx7J%z&?V6y#Gjqy&zdj|&ed=y`nVU>v~Tcq_NdXp$EQzU z4P$3tU17rkh53wSSeOIP5V@2F;*gU_<7-=36Rg6$RQ*7RtnCOsJq7t@jQrMqkS8u{ z3|rf2*K5NcMV{WWc-^;V9uRCN?fK>+czB=Wjh=tTLS6!aGYQOhczG0r2>drE>rmRN zz?YT{ziq(!E4yZP{$=+>ThVIZ`}w@nsgcTPjg6OfB^n=_Fc?UT&?fP_`Cgo7a8(!Q zI?@2ff-HD-_1TcSHc8}e5;S$4GxY6LV5woU>M~fl3Qu4EVWsLG?k)XTM^4U9ucca4 z6CVkuc)jm2y2SwAIG+!Md8wAN=N1Gov0Zyj&rAg6_C%J1c1z={kbM(=6;5MJuJU4a6i6x^*HpJcfClf zN(`d|*RY4|$+GhJpk@w3b^^n()HT^`{k00)#~Xnqh&J-7c4c@{t=VE?AL_43Iu=nL zf+_2fFx{r2h!~G~g~`qCryFE*SC?&o8}rffAw9gd?k1AExe#)Hz+O6fE60#VhrI(hgnWY=C*c3;}y*}p7ce$SdR;9&Cw=h#)+RoP{VvdxgT}Ed@ za~`G5(T$%i+1B3GW%Iz{j09kJuFc``++V!g-b7Nsl-^dq$^{tziA+ufgMe2lx(@^S zhTjA=@&oLT_BzOFC8?xjgx{*~iE3D8$qkK)jM9)yP#TtqN6wDta|q(3qf#lWjih6k zoIy(=@dWrD1Z^dKQm+Gjp!(VZ=^J&#tng7NLY{{aee(>*z^%c31a0Qe!E;Cp*J%NU zUB%#Ml@R})MU$WkTa1nSjSjw;^N_%~k_(|C5}}Gfx<{1wZ#Wvgd9nA6OZ>|I4vVea z4xir(b*TUlPL$+uSC`~(^E!PSReaKgsD69|wNG$Z$62Bac6$Z6i{Z6?U<0n$@NT3T zYqlfY+s+Q$P)akEc=iL#2GNO=CyJ;9;g$`K4oQR&1J6~Bt;X+=mUwCr46pf`!28Ur z;9~UF{`fad+!ipTA5I9@A|KlESV30jUUk7R6Ud`mmH3ZH<5o}vg<)cFY=W}QtzcvN z4{YgDue~Vufjt6+47~1ey0F}!okw>Ifq0VP;O1vyO`SEqPV;CoPh3ylo*E2W?7SxO zgD=4cAHxmDEJ5u`|G<~VPM)0w+1^42Vl-`e9F<|3}Mp(VIts&~p z(ze(#%!jH+s6`f5ttr0j=rDV<-PPF0z+CEIVD>VQh7UamYzB-@~Gw zV!z6xY2y}(O)Vrw{R3ViStrD*2~l8LAbSV(jASj<#DKN+RCUai?ybEjSGD!eHa4Fu zF=U7dWO5T^MWXgV6AIFB30MARjEu4YZ%BEURto`$kT)zIqN`w ziiFmiv16r5Gu8sJeg!R8r-O>v1LY(iYxi7c;C%4g?GbiOD&%FacXre1Z5*Z%w@ysa zuBJ1SmU@tW=&0UeAZmLp46S8PVcQuh<|V%yAnbKP(X#bzfDyyiKO_g_3Pnm<5&WVW zW)Wb3ypP#r5DzyxPW`qKNZ{g$G3K+DRlifT5yDSdxPl}%ZkzC_$xOayD)$9?&lCpgv);>( zfxG891M!I5d#lCnf*6fi@co^&IbA0Nw3Q;n#Kt^5YPOVqpqSy;4iu)_uHbly zI%tfn-pvyI=k;`wr2R4{XA4@>SH-nl2n`Qap(E_b3DRpY$dc52adbGPr~ z>8ch%o`pvBIHG~0zK_r;cDj-rM6U;I$$kJiH6ozhn&6guK9y0|XC>ry6nHk8o=jjN z5k(Di3cM72%-o?Nq)+Z^b0IZY^3azHS{|bd9==<6Y;VB_njxAxw$^gWifUHm*nsSN zbr->ZIo;`&$sqyTp5+gzn!o6dX#hF$N3Vk_^cYE21BzP|xl|@B5jV>^A=HeU9A} z;Oa*MQA#uD4nJjnrWp)s3zE=inYeg)K|N_5Wa1?{BPQa-V{Z?nB_Q631-9~XGdvLhN+K{+a$Dt8gKHcSP~FKypU{z8rZbgJYGW3|C}7J%ztAL zU9rD^pgeCv39FnM<|SHX;C>ea+rY)l{9Jni0|6_+x{UQC zU5;zybW3L9Xej>QMhG&$oY$L3`U5Xc7JE@@dOhr| zc{ekZbLCGb4TG^hrB0z^wjRb`a66lPRn;-8B-F@8&@G)8IW(d~O+6ZlY{J<8GIA4) zBt`M6rKMC^Sp@cwia;m)S+vX8g0tLaEYV(;s|?zWNd@+RQZIgaaldkU^78&?&)J%H z#pCpZA2eRJIJpL`n!%Q&fyDl8UcBUtt~A@9V}7eT))bJEhLsLmsf2? zOWti_{_c4wWnK#g>9d zHO2s1ChZZaGteOk6aULtAQgAdRa7EAJo@k<`qim5fWB(4%1JdG#j4{U-$-~PDLFOu z3M^mqNbg{mpRQ?DvLRgx4?o(?myUkP>;UK;P4%HfM9w+y zXD_Kb`ltP0@vNhy{grWL8RtfO0PS{r(K?a$aiXgXQ5zTG4$1uzno{Kuc}-(b)T1CB zVSb2?o-Lmpi^cPIGn4T$cnQyy6&Kzi6&5*l^<%0TY|!HjeRWl@$+`RK^p0+*>_x7| zh4B0nb~fUdTsskO@^L!Bm>4)kySXFTnl5hDRFs7ojuSPF3$7lt_s>O0??*qY(hb3! zQW}!GN(HJ;X(c9iw6RNP1bVBex^nFyxRjT*k{Jgk5A2`fa`Rr4$~*~#kUOYIDLzV2 zvJ!9cskbGJ-Qx#VSIS;d%_90n13%xoA}N2F=RY_Iw~!&L-#@C@-!EsCYI=SF#^2?! zdqcb?aXt#FK+u&Iah$`w+CMu;g&42t%YUw}-cDt2e-g~R@bkC2tr-ahaX~Y%UKujq zgkl(#wDA0W&f?${adH=kpdK6vF0k1$?D>bbr@|bD7m09}rq@F9->?3eJ)lA_sg`4} zZJghi`iVF9IxHBO8CPkl2ZuG)-m0AJMxqH#y;++X+K5 zbp~-(^iWfDa`i8i>`LYb38{$X^iO6jHdo-sSZ9?zO z&XC?^#(pJ?FIzFjOif44#6%6MVO$n7#5T&OV{L1976^jsqC(&t3>J+*@XT{F=T{ys z)swjgZ(P!6U@0pAucb~4KdYzy8CQKLu<4$k4jyXu+d|jOMLS<5jPJM7pA8q4!|Pe` z##h&4YrY4+SikDOT*-W~oAeLQ&-s1c)(gI1l`@ia&{xUErIIm0PP*cN`?Kzho$0|K z(ER-4YG{&>Dz62}Av9&aQ*+T*=T08ZD0!o=*IS8M;lgZMnt zBV-#(a0AgLyL=ww_|)%A;u_WL-&p^ZkL~Y4B$< zbiM)zE}HtMIgGygp=1FX&|HWTb^|Y}h@3T|%7rYy}zl3J-P!D2R5- zcaHoceDZ0SZDDfBGKb2~)%klbt;9aO)X;LFOdcN{9ji^9lT@Ki-mV3J@psE|?1wNA z@BrXtu9B*+Q7Zhaboq$tpQTX_?WABPD~zTaFs- zSwjD2dVx(4Sk@-my0MRx3}?jpq_e%)J80a#8|*{!*|egK*wm8kzbn&}x8!-h@SMx@ z{lXL@@z|gSxZZ!{p}8RVDlkSy;`u1tc6Z!T>|Bd8=ho3iBWTPL@B|cG*U_Qr2+T2s zY;(F**LQ#dx@G76vVRttCEryPPHSikN%BB&_yc37$AnfMdgQ(J zBwL(m?poTf674Nsk}4TXcw2;)0LmE_LzlL7XRAO>p4c-ySmoXQrENl&sv5Ix^|Goy z;=ovl)Uw-Pvz5d`n7=Xp49!B+FUd%tls*R!-wG<&l{P@`4iUFg*x@gBVDn`NYFQ@i zQ5f|ZDU~;=x_%B22mQXSX>ZBTCif-!bx{*-kO+?6GC=${Qo%xm#gc&tV?d3kIJ338PIhq` z!-4C4XvYfh&|ojet3Qpd^6)2AM{S2JVv5h|cTv+e{XV5`XDD%9;+%2x#oIIPweW8( zon@00wkHyfI*inzT6@Fv%mfmda>l|WuHLANV)uiG16ZyWz_rUKAlkiX zG0JCM1Ox#}WYib4q%tCg-a&6`{bdB0j9`MduQ#mP5$`1;bzQSTe7#5$>|LsM|934* zRhmTF;bLI8IfbSOhB|TwcjKgWQ^&|Tg^a545k*%#M>NshijxK<@nACeF%-v8jvO;9@XNvC zFClnYc9_G|E#ozMv&B54`&z}Ym$^4n3x-IE)2Q5mC*rp?$lBrP{OGp$(L)2k{B6=J zCGXnEnR}~NZ)8*U_o)2A=!W0f?d`zqsv@@7UivL&w?=oo8TLP&bdP)p%nt(nfm3`Q zEn0tibWU}vMyj}Fdk|~)o_cBfZAk9BcL)OnZme~F&(G{NhFNY-DI5#f25Q;ZRx5f7 zTkP+huT2Y~EPo7hihIlM81-)KGJzPjwRH+!wxOUoD#}Da6?P%@#9m~=X}LnY@CR3Z zE=YEv4g6oIF7Tk?VlKrp;5el5WP)TpJRj1NP-`*=6s{50Kb_Uk>%SfNkoPHkv25lH zz^y}Mpn4;@N02IGnk_Q*>GVTG7F=xU^>xWFPHs+MZ{a)q>l1tIv%pbq8EyE69z#5r z<~%?uG-vVyVQ~|E6H)t)BE+jT_9033$TI9ayk2H&((hnROh1FxFauk1zClD4r(*P9 zH%xLBNV_$E(L^;yTd)jnY1(n-wBc3|7-D)B^QfDDPE^d!wlv$+O-#=&sh&YI;L$eY zk}b!5v_1ZS*e*Es|4+#7e+bI`A7JDEMXb&sVe9MX=jBD<^ZKU_6i7)6=Fk5W`#%N| z{%=uZR`&lgpP;KGFSBHTdedfSTeNL5Jt=rvnK>2V_)81{8$(E-Fa#_}FT!g;RkyGT z3&)=tg;xrVgj&KT?XncMa6hCJ5uViSR}6j(7R8|?GN*?Zfe*<>Aq0!3=Ub2e+n3&s zaLSS-QAp*+vPq|>z?rf=wUf4#qFj!;J?ViPRali{>}<3~aXo?IL?9V9fnyX-*5XHW z*+>(Eu-}en;A`c`G~03IZ%Sx*4Sdd?+dzIRB5_cH`X$qE%n@Q0qUC0t>%K1nRcDtZDN|Dy9OG>9wHO*~L z`2fvE&0^g&er?SIo>Nj;A{a#$QEpn)0(1p~GAZ`Ef=C&ZG}#TFkYJADJy_5c#qo=LmkbxQ6_R)Oa ztmS;?{0VC5P6wfR9GJ3nE*N!;Y^SR&Uk&f^ziJqLs5`Vh`I@VJXY;b>1#vF%Nzp~5 z0w%f5&bOfFU~e*2)o|vlblj!^-p(jnqbYc%tbOJu6=c;=b3-=A+! zX?Nl4F~5&RH4N^<5?}nyAF>jW4mk!dK?<3?H~)@XgX3!F|Jq%(5Ep0ZM5alN8d0KZ zMSk+WOfT;be=G1^IDB^9q;3mGP~(OO$v=D@AbsTV{LTE&n?CpOC2+Oz0D3Oi{b%&i zCD8o`93B4+@IU3{f6T7@?{gmTUp$Ac4G4iU`int|3Sa_zs+@K0Ly=& zWw@#%xS*(Z%4f-Wg({S=mYV~h_9{P$ORUfm)HN`=wvrjk_3|3WH(CR zmdG>T$dmbPznf((g{-xqSp*#12g+#AgBmZQD7|iZbn-45Pn{78Pjj8R@_MMQJI8ou zkG8ftocnfPe!6xg$kx}9D^$F!JyRvi^sUPm*v?kfGS6Z1mRDHW)mTk;c&TSG>>)y> zR3t@ORF+L5VN4Ec){B*hq-h%auyXxX0Y9S*f9E=ex9AfkcDobfG?O|WPVCfaiv zQQb{eL`UMuI5m+gOlnQ?M94bCy~15Wn?FB3)mAYpTjEzNp2%}28YMSPma!hQykXM$ z>${ihhZc+f!E%<@G@UQKK_Fb{)>d$`Sy&UStD>tW^(^u>luIhwEC?7@_*EO7GX`vS zOLQyMG|MU(S=Ae(HEL6AvZ=k~O^tHuCHbCp9ohF4D=X@(D^{>AS#TROS!N`rbrsf3 zEH{kb#R^To^~{$u;AA&h9{VIW%WIgdtXXEfCe@59SFQYd8;pWWrwiCE|2e$2conHB zD--~%TC%*7EyskV(=xIypy6a)rLE4;50geOykn%9Ou$U#d3t{rd@d}Cw z(UGPKsQoVCbm^9&c3fd15VwaE2>3=E8DWF=!Ca+emZ(BMkV<+Ynp(oy+AHP1eedRb zo=RH6Dn9tPn3OuoLrgUpJOUeG0uX$<%n zC6}Oy$n)MPTBpfHUgYm>V`@xx3T)rxJ}x{?puRBW83kBXJZ(2NHVe2*7!=;$)Ge+`B}v(83@azVsOmbiN{x)oBkj&Vb>$Wlu$p2OsU1ykfb>1RD6P!hACl{3U{4kkf*!+~>4MV;Ru;4W-~tk#S`h zQ6VohzpxooPVFs;2VmZ|i@R{+@2P0CZCV}W1lFqHd&ayB^d0<#8z8)cT3~=0Hkiv( zp6gSDFltcXPlzq7UVk*_|CQ4Yf(P5KRl|zUeR9+v#Z_TMokPJ$a@*!I{E zk!)Y9#0xgJ%(~1G$DdwaB4=0Qs71@QiJ~Gao&t>vo`*oL_&GfvO;zci57TULzrm{} z(pa|2OpmwuL|Y)o-P{S1hyO$w17lo|@a+8p0zGU%c@Pj+Mz~xRb_(NRX+c^_Q00$> zDCR-mi?Uln|CNfo!kT~^t@bj`4A*i?xyBblXnKiJc;#kR)J3BZpM#tyqM z#H%^heJ=Lc40&9p!unRwDJ_SkmVi9F0Tq)FZF=e$sa>*xc*Yy#Ed_BN3C zqVS~R+-nE|v*ju0^*d(uF_&Kh!%s!wsN4MBDwGw&YYre0Q^kA^{d9Ce?|X$}6gHH~ zj?Qg9z?0rjRM|;6NspWOoGY7^->yY{c3ChGSQ0<}D`#;XA)v%70P2u{XXHx@H%4C< z>`dY`^@w;_zTYVYq{;MA$XJfPn-C9#z#DvuQf(Xr@X`YQ#mmb=`5T4@Kkc}EHa9+z zn~h&IZ81cX%Kpg1O1g7mH~u>Sg##x8p|BO4b*)D&{?A3R*HZKiW&qzFs7j!EeIQaH zOMW?nt{+9L`|S4iqEh4bGhsof12T7J9+aL(;JZl$?rx*~nD6XBYtf~L(jSL5k0eKagikl>Q{s+wwxYuq z8^J&K%_K?eGXOc=F1t{S4jUbq)HeAZ2))~zP{Y?6^NcV#eo|w$oeI6f;FAh!Kgd@I z#9mq4ll_acsu+Vi&W|%Mc~VrtgGMT>xkRv~GN!xJ_mzGiJkWF9dTmS)mniemy%_Tt za$Ka4V(L@Oy}h&ljW)_lPUNz_%2=U`n2B7Nt2vug>qMDaB`#{fS)cP`>>fW)kCcuaX+2U z|3_;_4=2isB#Q$$%1L>h@n(7?zXl{FX{bi;1NCO_gZ2uHKH>SAW#M0~)aL5SHelqF zAruizY1{6S_m|bjtz}-5o8zs`cc!1~4K*rjphU0tOLIfUxoW~4XVb7L7*<#+AwE<1 z7(T+w=>wao$AGW$zmtFNLflP-Gs$WUw8^e@-BQyJI~w#_d-?=ah+}Q^K{dxuRR^Nz z*sX+~R=k6~L1x^%H@p81LR}0y(ogdd;JpJ3HL#3n)W2{P&4cm+>mwAZy@B|<J~ue#%LzZ#wQPx)6zRDNLeoO(NUT7l&w^#=D4^X;XL4&O%53&&!*)&BYT8@^|XCe9;vJ4|W#g3lhG;Qr8 zJyn`9_~aeE@y;cmq@PSsybUI3!3{8Wm;Jtj>)bx5tYlenM5kC!vu2YbQ=*D5K!%pY zqz&XblT2;akM+~98~hQvKVlMbMNzzIo?J(s+4Q%umLh`0-^z{t*Qz7>NEK-b#2x>m zcw~8+$O9P$U9dfmq5$;>Lpo&DzPI1GTFoN2tOZJXZ{*KteKm`p}FyX zouuQHxSTD}OBzS?LnG=JdOF&2wm=aS%K~4CbWm_J%wEXQK{N0M`1G*mo*`5im|NI$ z`??bfBew+lt3?>d3XzT|M0b_E&jua)$Hlfu+FTF(!W|LCno{1W&x>tw8hD+U->sf zosni6baE06$fus=*n_Ij3h$K8#&zM;T^OwhM=IMkAe`HLe$KChp9 z1!Wkv*U#(;VeYRTcK|+4H?U2_rL06pKaN6qSFs?Kj7uDmCO>LPER$3nLW0DpxSAEe zp5~Z!p2Hry@#4h?l(psi5_!)apUJu+q1dsRur{H59qnw4hq9d^KIyvJZKmpC zZQ4%*j{*#ul%Ev3!N=00e2m!L(q9?t$T#*C#Z8+dowVQddb8v4$%e}`Czj{Uy1+Xa z5qBtSzP3+t-*2OYI~UvHVP0C7VFf>fB0yc}Sos~*7+glWu!qjgW<8m^_K~e6fJbS? z6`!))m^Fi3W_jBE_@RZR$wN{4mm2naWF)jVvV!K}VNmgOFlCT8vQl=jWsoBTaB?z;Svonp z5CYiQ*#2#8Tuhx9#B2;*OhrtM?M+M>WK8YMT`UM$0j&R}d3mg3?Yt?L_Qlr+vOAiS zGVaIUs#N<#;-=GZXmd%L?C=_xXb`H}SYCKq{c!V=V;5kN1SC4D*vMT)4IO{o8}BT? z+Y1CasSqhuAyuhSp+H4PO-FNOR3dBYQ{G%>6Bm|QkQhKyVs$B$eDhXm|DwKSKZXFXGybkN4mxqBS!|3M^#Siu?~hdC)JAVD?&f;bC^Qgo37P7h$#17-S5&O_9E4rB&? zF8m`x36G==^GL`xSVu`iL)r?YjHnu1L(vI@v9VW@id{5<9K#gWg=%-|6zEGhHiROH@3BW=Sn>oLIFLy=fd&a{ko4=64UrO<6Uh*E9+3#o zg?M`ntaWUhelHmajg*u_P@!ZHJ{VL{PD;Mf5aL#HcqGth&C!5pjgTxWCD3VvId3`y zm#!T&%qk&(B-gDJWGshVG$4UF>QYo+*h?Cc?NK>ts7&N^CSL4-3er8Awy%(FN zjCA9oGXx-kBRX=D8Tf&&A3NhO991x=JrsP#9ty7`;%NjdEU+PjVlZejsSG^QLTWuB z^?)LFGpVV-0cM0;mKTV!>?o>kA&vwvsEi3Te$S|mIZvkP;^yk_MR`~!-xU_Bg|2V&G05U4q3QL&{!6vhvVl?3nY*%f+`N-#9+E5;<7aJI5WS(fv9;LF)1XPU{2^q=Lnj%1w@p; z1RPS$2@p`!D8x;y#1gSr22pTg8gjWT9|)-J4vRPsyaTOnfdG}wXTJ>oU%>`o6jydDZqwpW{aV1M%Bdi#6UG_m=9=yiYa_1Wl`#2)|f zcjR(^s1J{+V5u>&r{P?MOy5U`-@hrZ&YC_CmF3dyw=~MWVf@cOC+08z%EljgdZRI? ze`+qke|q0{xoy7@M4$I~-koVrf%8W8^v(P81seOj?7lXEKl*YO{42lxf57hIY5DEw zcektQ{l!k+ymaeoDdaEoF;1S^<_O&Jz8`$($3Q+#9;Ac>`Tpb}Zbvpum5pBS5AnPn zAAA}4a{J!8c>00ws$DDuV_dv{X-qEI+&_K#_WVIl%9f2+tRG3l+=nja7O}4UG~2XN zDzb7}lM{938f--kAHHW5>F6L$-l$_GBHO~iLE?oyAP{R{B-w(;RZCedqlA9EVEe!13&^*G+ayFg;tdr3uiJbUzOX>ZR3-!XkpV|Q32 zC%Ai_NjNS=+jo~`C)r^+jcFj+VLpx9j%b7LH0D3R3nAkDz0ee{fGMeIgecy9RnG}d z%8A1g9-xqQjR|?2xm?!#WV_1hK@KComqCjgsNV>Qy`^L%0ovVJGq)Oj{KP-%Bo2eC z97=L4-SW@RExqb(hT#X3#*L}VoHb{oNzlQR_MfG*1g}nE>W%^7#xRZNp|twO;bZpwuFHlT$n!{=LrU zxBe9VR}|mnYn?&z`W?afOx#DpShgj^vbApcjj+D*W!ww4UMAiRYc&h^PE+Y-Nhl?DbyCl1{l#}f)fpPSCXb#V+bWD)Y5@#){c3NERDp$;JT=k_^XD9FqP<&df z%T}sV2<_e4buV^Zi*0r1ZNAQKGn=*usI$Ga4aAXyUDJNvWY@gP=-$qLVf%O_y5ZPf z9sG46V-I87?7mt4YzrGqPMvl7v20m+5vmC4whB`ermgqbQZI-vIE`1t{HJDS*-iG_ zMV9aBSY%dLbV-%9X^@R-%|7kU(ro%DpZ{A0jCZv9k665}>(~Cd)pJ|LjwK6ITp}a5 zmTQVJst#z)WCkGZ=(if(XaEiWrh>{*y1XI7$TJ0d{hkn%`_I%9(HQVk8@>mfUSm@vMUkCEw&Y2+GMj^9JpwC z&369T&Au7`BleOvJ{U*bU7!UQhkvaaZ+<6X_>%a*F!L(QJ=idnlG4mwmYFaJ_gSm+ zUz|e?n`*a%dd&uFwTgA{;xxV{udJ64nqSgyd`s7u+pEbt+ z?^#2J+aJzKu|>R$6jMI+^7f!01R0I!6XegV1i+N4AE3(El`Wi%Rf5diYt;sskGz%M zu*%_{h0iDsxZ1m`TkP+QSdWHGr$Z+5;S&b%*=F!d9t<0!7e@D2?4b9ccPj8j$BgBB z70^SOs8baQ5J_6u`N~BUBq8J@^q`SvOrQaX;lu0S@`|++&$=DA7!x<<(mVrtg{+xak8v_ZC!rw zq+R{(2I&6<)H<%efnI0eyZ37T=_@_?47G3AWrx$Pv}>(lSoU5J@ZNdt1-ohGr^025 zw{(=yJ}B|F*`-#KelRw4OmNqz#$Lw$g`(8jRN6xP6uGXoBr@1>8EJ1?(6{8`4AkS=no*b z!bI^L6iM9{DXGH2^n=(>y@<%)vmp28gz_5GbxHWfFZZHQbpHdNkw>T2b^)iUH*3#s zlF6g#2NYoLMJO4Pq~{f&XT>d<5hfPN)KG-Ane_F$U|lr5D)*|~7`oHe*dKyUM>5*R z(Ym*1$VWAU6sBA_)7rURCOh~Oted&6gkUedPKj%tBkyh0vnlCE-?);XG-Xfw^s z%*Je2w~6$ze_~_?cuO7 z40*_74H>~70{`zdt6efubhY$#dv1n(J(dJQ??C&AYjlwz1+Ok@i;&HEgxmQrIsHv1 zRoj4Pf2$hC@pfbl_UKA(LZWJ7B7$i+II{gSl}8C+hiXk6+^DMjJn~p=Bz8`%b z$D&x;PfYiYjG^7!qE6?&ZVrBh11))@vNWP%tH19W%Gm$X(pRPFmXT&@2kv&|z?n9^KeZIiw<_OV6my zTFGFwNN)T$dI|LRyeS|vf28f-oAOA2GRkBX(vn^Xhsad)+^Nt0V)Hosk7um(&-8s; z-}W-1zoz@`hS}N^_E?*;CLj3K=t=mBc#L|Z|7XLyYTx(gaJzl?CVrjhkB9T+>wOhk z_H`Rvt<~!FV*tgjMOAB_!3|u?w!#wJ%$)cGUX>K9ymZmU%K*aLp1aQ}f&Fsgp{zgb zL(`G*X!iGAFfJtb;RmO|apGYO2UA!tj7aa0nk{cRA6wYlo!-NAm+ujta36}@cx3xw z$Q1!WJl<~IZUxC$mmhLFFmm}PUa64}Ka>uKTQ@&bL_@TQU#$|SyBFdE-7+=*YK0Cn zk*Gi0ozpl}$5jXcrhOb<-N)F6@z{%b&|fvNIgb`*zUTN=@i>I@a>7=(GKr%ua@B+~ z2mt?g<$X~pHNTQoEH;Y}i~O1KLkgdHXqrZiZPP^6yAi;@`;&vrQGcgL0eZSii__EKf}H`_*y6I=S&aqjCulE3m@M5zO+`giYmcMpAFDXidzG43*`+PhKS=>|HCz(_>FTQ6XXal$$4SSGxm4( zpZkL$&mOPayMxt{nUSuSe_#MF&+ z4dV>EoUNB=i&SBC1}CrRi4=*VbuWhb_H<|kbnX54SK7^UsLw{W<|FOrfhMA+ zCQXukaVfhuD1Q@TDGOC+#q$}NvLA*KxhPXNQz7PA=DppM8)_w#5Uvd*UG5W=5+Iw)l|`Hmt3hOl&LjMQH{jGtSaz zW`!EiFt88ngVSV4qT5nIlyAXoF?(Wzbs4t7esa!VaKwHUtCQcTe6G(~*A*41d|hKT zQb9@D5iE&;OEFBl2VmdL7+^g59BL7u{7~#{M9T`(y8GL-j47<}glZA@? zw>7#m>1e(N<5<)TKym`EhD(}axa!Ejc$>!xLR0B8JywP`ga|%3TVg`^uX>GfAv_M?{>QQ=~1cJETs%_ z*G5)nl%rXpct|^zgMXFb28qQNz<=~^szZxr%B za;ZPtX|_`l;VtJ)bh%jj#CN_&JyEkgGTj;o+XLppJX)&Yur)_&1U;)<(#hsb{EKR4 zpQRP?+qF1QTDx{-CT@8qZdRAH@z1jKd00^(ifAyFn#DCC4dCKjAg`z?4kV=5jpT^M zYJP+=cDUS(nlhOp;otax?L9*}#yD_`0UZ0dr&xl9ZSH8g3AsJrXSW>8MsyjES#SnV z-tJ1pQyGDN&)4~rIfH&rrv9#!p-o&UzhIcjlNEwcIo7klVg|O*Yn=O$o+{I zi)T+~xq9@)6a)jkf-wC`Uu?ng-@lc9b4f||0}9Ve@6SFh?Sh8sdTW0t-yg%FMF)<; zALBgSwJTd%Z~&ez-g26P9DZ-aSNVp%dEJ4kyAMxJwDauxE74Q>PG#bKdf)Z!8b5>j z_7aWwP0Ku>CVw&ytRL{9FsgDgW%UdU^>g?;d%G)X0G@8Feci{aqQz(l-#AiZbBYK$ z4E7guq8}K;E4xFZ!fI$=kd0642bC+IZZfrJftImOnpyZ`?1EgxT;_DA=K6BI?R@%r zgow!pI$;+^@StgDLX7FV_UXI24D(%o+Y}Ho=jW0s^nJdTUib%+)Tb_vr=ED3My{Dg z2u4r|T*gpgtulg|@D$g|NTLwQ6ss#{Sw1e z`W}@#ke@q@PomkY4~(z)L#bD+K14|_{r)xxHHt68PFpAzo(06PhU@mE9>{vqXryxcQ;FWn8p-;gTVyf3xpeXSJU`~t zcWtJTUL?~0c145fUQ#TO!7q*sC((1&2z>&GzKJIZWYPscr8+ZgJKIrCnMi+3I?H`K z+n3Jn-#^UtzaOFpbG)@8?vqoJXzr4w&@IEp51Oebf@tEK9+ma!zsND^%f3&ON(cs% z=nbRkwQ>Z~_4X;8M=qU5@@G@)c6vQN4qs*}J?b(=Z_wM{+d(iweHB|N|D-Ta|_jqU*W0-C}7Pd-ZxNIX~RJQR;!X_5q0H@NP^7mwj_VR|#JtX6ZBuJBi! zs10T0XK>`_*yQ{C?vGdFqePjCyb!hkU1W7{#YwC1yB+{TYeQ(+iK;j4bP4&*Y0hLb z+U8_Mh)sH>1NYQEVTH8E^;*9fsy{aYugadrFEH5aYN|h=W3yMp|Gfpt#KQi+^dL2q zOwAZ1MYMU?0j!3m09Hm5qkoHqor#&nn9-D(nUUGV*bKnJX3Y2h|Aj7tlD)kPG~nM6 zN(_>AX7+^tFDj(Opls=7O31{*!Jw`UAY>+F()~YmIN3S=6OdtDURRC<#vHplnMi9H zSBt2YY;2Bz)I^Rk&7XhnZ>TE8I=D zsPRPl-hy(eboX4b<7<>3sGCW1^OPVXT1b2I6d|M9NJH>M&%7#{8Wr(gMVzP<65F1I zoTwTx+1w4oP&-<-x{Mlq2GLPRB0V?5=&4E8)|b%eDN0T>m*D8BO4_%UaO){gycI!3_d%z?dK6!uEGyhSNAw!H<|`giJZ2)s7l+;3_jhlQ>ex^;>damF<~r z1(7)7nC-)FMHV^0h8h2o87;fWc$ zrBpLO${UsTK(gO+?T$UBCWAjwO9_7fU}FClZ%Iw UsTni}GbbwtG#QzwycqQV1Lf% + select(X1, X2, X3, X4) %>% # Select covariate columns + summarise(across(everything(), list(mean = mean, sd = sd))) %>% + pivot_longer(everything(), names_to = "stat_var", values_to = "value") %>% + # 'stat_var' will be like "X1_mean", "X1_sd". We need to separate these. + separate(stat_var, into = c("variable", "statistic"), sep = "_") %>% + # Covariate summaries are often reported for the overall trial population + mutate(trt = NA_character_) + +# Outcome summaries (number of events 'sum', +# mean proportion 'mean', sample size 'N' for y by trt) +outcome_summary_bin <- BC_IPD_bin %>% + group_by(trt) %>% + summarise( + sum_y = sum(y), # Number of events + mean_y = mean(y), # Proportion of events + N = n() # Sample size in this arm + ) %>% + ungroup() %>% + pivot_longer(cols = -trt, names_to = "stat_var", values_to = "value") %>% + # 'stat_var' will be "sum_y", "mean_y", "N". We need to parse this. + mutate( + variable = case_when( + grepl("_y$", stat_var) ~ "y", # If it ends with _y, variable is y + stat_var == "N" ~ NA_character_, # For N, variable can be NA + TRUE ~ stat_var # Default + ), + statistic = case_when( + grepl("sum_", stat_var) ~ "sum", + grepl("mean_", stat_var) ~ "mean", + stat_var == "N" ~ "N", + TRUE ~ stat_var # Default + ) + ) %>% + select(variable, statistic, value, trt) + + +# Combine covariate and outcome summaries for the final ALD structure +ald_trial_bin <- bind_rows(cov_summary_bin, outcome_summary_bin) %>% + select(variable, statistic, value, trt) +``` + +Viewing the data, + +```{r} +print(as.data.frame(ald_trial_bin)) +``` + +The `ald_trial_bin` is in a 'long' format with columns: `variable` (e.g., "X1", "y"), `statistic` (e.g., "mean", "sd", "sum", "N"), `value`, and `trt` (treatment arm, or NA if overall). +This is the format `{outstandR}` expects. + +## Part 2: Model Fitting - Binary Outcomes + +Now we use `{outstandR}` to perform population adjustments. +We'll compare treatment A (from AC trial IPD) with treatment B (from BC trial ALD), using C as the common anchor. +The target population for comparison will be the BC trial population. + +### 2.1 Define the Model Formula + +The model formula specifies the relationship between the outcome (`y`), prognostic variables (`X3`, `X4`), treatment (`trt`), and effect modifiers (`X1`, `X2`). +For a binary outcome with a logit link, the model is: + +$$ +\text{logit}(p_{t}) = \beta_0 + \beta_X (X_3 + X_4) + [\beta_{t} + \beta_{EM} (X_1 + X_2)] \; \text{I}(t \neq C) +$$ + +This translates to the R formula: `y ~ X3 + X4 + trt + trt:X1 + trt:X2` (The intercept $\beta_0$ is implicit). + +```{r define-formula-binary} +lin_form_bin <- as.formula("y ~ X3 + X4 + trt + trt:X1 + trt:X2") +``` + +### 2.2 Matching-Adjusted Indirect Comparison (MAIC) + +MAIC reweights the IPD from the AC trial so that the mean covariate values of the effect modifiers match those of the BC trial population. + +```{r run-maic-binary} +# MAIC involves bootstrapping, which can take a moment. +# The number of bootstrap replicates can sometimes be +# controlled in strategy_maic() for speed, +# e.g. n_boot = 100 for a quick check, but higher +# (e.g., 1000) is better for stable results. +# We'll use the default for now. + +out_maic_bin <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_maic( + formula = lin_form_bin, + family = binomial(link = "logit") + # If your package allows, you might add: + # , n_boot = 200 # for faster demo + ) +) +``` + +The MAIC results (default: Log-Odds Ratio scale): + +```{r} +print(out_maic_bin) +``` + +The output provides `contrasts` (e.g., A vs B) and `absolute_effects` in the target (BC) population. +By default, for `binomial(link="logit")`, the effect measure is the log-odds ratio. + +### 2.3 Changing the Outcome Scale (MAIC Example) + +Often, we want results on a different scale, like log-relative risk or risk difference. +The `scale` argument in `outstandR()` allows this. + +```{r maic-binary-lrr} +out_maic_bin_lrr <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_maic( + formula = lin_form_bin, + family = binomial(link = "logit") + ), + scale = "log_relative_risk" # Key change! +) +``` + +The MAIC results on the log-relative risk scale, + +```{r} +print(out_maic_bin_lrr) +``` + +::: callout-tip +**Your Turn!** Try getting MAIC results on the **risk difference** scale.\ +Hint: `scale = "risk_difference"`. +::: + +```{r maic-binary-rd, eval=TRUE, echo=TRUE} +out_maic_bin_rd <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_maic( + formula = lin_form_bin, + family = binomial(link = "logit") + ), + scale = "risk_difference" # Key change! +) +``` + +The MAIC results on the risk difference scale, + +```{r, eval=TRUE, echo=TRUE} +print(out_maic_bin_rd) +``` + +### 2.4 Parametric G-computation with Maximum Likelihood (G-comp ML) + +G-computation fits an outcome regression model to the IPD (AC trial) and then uses this model to predict outcomes for each patient *as if* they had received treatment A and *as if* they had received treatment C, but standardized to the covariate distribution of the target (BC) population. + +```{r run-gcomp-ml-binary} +out_gcomp_ml_bin <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_gcomp_ml( + formula = lin_form_bin, + family = binomial(link = "logit") + ) +) +``` + +```{r} +print(out_gcomp_ml_bin) +``` + +## Part 3: Adapting for Continuous Outcomes + +What if our outcome is continuous, like change in blood pressure or a quality-of-life score? +The principles are similar, but we need to adjust the data generation and model specification. + +### 3.1 Simulate Continuous Data + +We'll use `family = gaussian("identity")` for the `gen_data` function. +We might also adjust some coefficients to be more sensible for a continuous scale. + +```{r continuous-sim-params} +# Adjust some parameters for a continuous outcome +b_0_cont <- 5 # Intercept on the continuous scale +b_trt_cont <- -1.5 # Mean difference for treatment A vs C +b_X_cont <- 0.5 # Effect of prognostic vars on continuous outcome + +# Effect of effect modifiers on treatment effect (continuous) +b_EM_cont <- 0.3 +``` + +#### 3.1.1 IPD for AC Trial (Continuous) + +```{r generate-ipd-continuous} +ipd_trial_cont <- gen_data(N, + b_trt_cont, + b_X_cont, + b_EM_cont, + b_0_cont, + meanX_AC, + sdX, + meanX_EM_AC, + sdX_EM, + corX, + allocation, + family = gaussian("identity")) # Key change! + +ipd_trial_cont$trt <- factor(ipd_trial_cont$trt, labels = c("C", "A")) + +head(ipd_trial_cont) +summary(ipd_trial_cont$y) +``` + +#### 3.1.2 ALD for BC Trial (Continuous) + +```{r generate-ald-continuous} +BC_IPD_cont <- gen_data(N, + b_trt_cont, + b_X_cont, + b_EM_cont, + b_0_cont, + meanX_BC, # Using BC means + sdX, + meanX_EM_BC, # Using BC means + sdX_EM, + corX, + allocation, + family = gaussian("identity")) # Key change! + +BC_IPD_cont$trt <- factor(BC_IPD_cont$trt, labels = c("C", "B")) + +# Aggregate BC_IPD_cont for ALD +# Covariate summaries structure remains the same +cov_summary_cont <- BC_IPD_cont %>% + select(X1, X2, X3, X4) %>% + summarise(across(everything(), list(mean = mean, sd = sd))) %>% + pivot_longer(everything(), names_to = "stat_var", values_to = "value") %>% + separate(stat_var, into = c("variable", "statistic"), sep = "_") %>% + mutate(trt = NA_character_) + +# Outcome summaries for continuous data: mean, sd, N for y by trt +outcome_summary_cont <- BC_IPD_cont %>% + group_by(trt) %>% + summarise( + mean_y = mean(y), # Mean outcome + sd_y = sd(y), # Standard deviation of outcome + N = n() # Sample size + ) %>% + ungroup() %>% + pivot_longer(cols = -trt, names_to = "stat_var", values_to = "value") %>% + mutate( + variable = case_when( + grepl("_y$", stat_var) ~ "y", + stat_var == "N" ~ NA_character_, + TRUE ~ stat_var + ), + statistic = case_when( + grepl("mean_", stat_var) ~ "mean", + grepl("sd_", stat_var) ~ "sd", # Changed from sum to sd + stat_var == "N" ~ "N", + TRUE ~ stat_var + ) + ) %>% + select(variable, statistic, value, trt) + +ald_trial_cont <- bind_rows(cov_summary_cont, outcome_summary_cont) %>% + select(variable, statistic, value, trt) + +print(as.data.frame(ald_trial_cont)) +``` + +### 3.2 Model Fitting for Continuous Outcomes + +The model formula structure can remain the same if we assume linear relationships. +The key change is in the `family` argument of the strategy function. + +```{r define-formula-continuous} +lin_form_cont <- as.formula("y ~ X3 + X4 + trt + trt:X1 + trt:X2") +``` + +Let's use G-computation ML as an example. + +```{r run-gcomp-ml-continuous} +out_gcomp_ml_cont <- outstandR( + ipd_trial = ipd_trial_cont, + ald_trial = ald_trial_cont, + strategy = strategy_gcomp_ml( + formula = lin_form_cont, + family = gaussian(link = "identity") # Key change! + ) + # For Gaussian family, the default scale is typically + # "mean_difference", # which is often what we want. + # We could explicitly state: scale = "mean_difference" +) +``` + +```{r} +print(out_gcomp_ml_cont) +``` + +::: callout-tip +**Your Turn!** Try applying **MAIC** to the continuous outcome data. +1. +Use `family = gaussian(link = "identity")` within `strategy_maic()`. +2. +What `scale` would be appropriate if not the default? +(e.g., `"mean_difference"`) + +```{r maic-continuous-solution, eval=FALSE, echo=TRUE} +# Solution for MAIC with continuous data: +out_maic_cont <- outstandR( + ipd_trial = ipd_trial_cont, + ald_trial = ald_trial_cont, + strategy = strategy_maic( + formula = lin_form_cont, + family = gaussian(link = "identity") + ), + scale = "mean_difference" +) +print(out_maic_cont) +``` +::: + +### 2.5 Other Methods + +`{outstandR}` supports other methods. +Here's how you might call them. +These are set to `eval=FALSE` to save time in this practical. + +- **Simulated Treatment Comparison (STC):** A conventional outcome regression approach. + +```{r stc-binary-code, eval=FALSE} +out_stc_bin <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_stc( + formula = lin_form_bin, + family = binomial(link = "logit") + ) +) +print(out_stc_bin) +``` + +- **Bayesian G-computation (G-comp Bayes):** Similar to G-comp ML but uses Bayesian methods (e.g., MCMC via `rstanarm`), which can better propagate uncertainty but is computationally more intensive. + +```{r gcomp-bayes-binary-code, eval=FALSE} +# This would require rstanarm and can be slow. +out_gcomp_stan_bin <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_gcomp_stan( + formula = lin_form_bin, + family = binomial(link = "logit") + # For a faster demo if options are passed through: + # stan_args = list(iter = 500, chains = 2, refresh = 0) + ) +) +print(out_gcomp_stan_bin) +``` + +- **Multiple Imputation Marginalisation (MIM):** Another approach for marginalization. + +```{r mim-binary-code, eval=FALSE} +out_mim_bin <- outstandR( + ipd_trial = ipd_trial_bin, + ald_trial = ald_trial_bin, + strategy = strategy_mim( + formula = lin_form_bin, + family = binomial(link = "logit") + ) +) +print(out_mim_bin) +``` + +## Part 4: Understanding Output & Wrap-up + +Let's briefly revisit one of the binary outcome results to understand the structure of the `{outstandR}` output. + +```{r revisit-binary-output} +str(out_maic_bin) +``` + +The output object (here `out_maic_bin`) is a list containing: + +- `$contrasts`: This list provides the estimated treatment effects (e.g., mean difference, log-OR), their variances, and confidence intervals for each pairwise comparison, adjusted to the target population (BC trial). +- `$contrasts$means$AB`: The estimated effect of A versus B. This is often the primary interest. +- `$contrasts$means$AC`: The estimated effect of A versus C. +- `$contrasts$means$BC`: The estimated effect of B versus C (usually derived directly from the ALD). +- `$absolute_effects`: This list provides the estimated mean outcome for each treatment (A, B, C) in the target population. This can be useful for understanding the baseline and treated outcomes. + +For example, to extract the estimated log-odds ratio for A vs. B and its variance: + +```{r extract-results} +log_or_AB <- out_maic_bin$contrasts$means$AB +variance_log_or_AB <- out_maic_bin$contrasts$variances$AB + +cat(paste("Estimated Log-OR for A vs. B:", round(log_or_AB, 3), "\n")) +cat(paste("Variance of Log-OR for A vs. B:", round(variance_log_or_AB, 3), "\n")) +``` + +The vignette for `{outstandR}` (which this practical is based on) shows how to combine results from multiple methods into tables and forest plots for a comprehensive comparison. +This is highly recommended for actual analyses. + +### Key Takeaways + +- Population adjustment is crucial when comparing treatments indirectly using IPD and ALD from trials with different patient characteristics (especially different distributions of effect modifiers). +- The `{outstandR}` package provides a unified interface (`outstandR()` function) to apply various adjustment methods. +- You need to: + 1. Prepare your IPD (for the "anchor" trial, e.g., AC) and ALD (for the "comparator" trial, e.g., BC, which also serves as the target population). + 2. Define an appropriate model `formula`. + 3. Choose a `strategy_*()` function corresponding to the desired adjustment method (MAIC, STC, G-comp, etc.). + 4. Specify the outcome `family` (e.g., `binomial()`, `gaussian()`) within the strategy. + 5. Optionally, use the `scale` argument in `outstandR()` to transform results to a desired effect measure scale. +- The methods can be adapted for different outcome types (binary, continuous, count, time-to-event, though we only covered binary and continuous here). diff --git a/vignettes/Binary_data_example.Rmd b/vignettes/Binary_data_example.Rmd index 3db45ca..91f196f 100644 --- a/vignettes/Binary_data_example.Rmd +++ b/vignettes/Binary_data_example.Rmd @@ -131,7 +131,7 @@ information to the analyst. The simulation input parameters are given below. | Parameter | Description | Value | -|------------------|-------------------------------------|------------------| +|------------------|------------------------------------|------------------| | `N` | Sample size | 200 | | `allocation` | Active treatment vs. placebo allocation ratio (2:1) | 2/3 | | `b_trt` | Conditional effect of active treatment vs. comparator (log(0.17)) | -1.77196 | @@ -151,7 +151,8 @@ The simulation input parameters are given below. | `b_0` | Baseline intercept | -0.6 | We shall use the `gen_data()` function available with the -[simcovariates](https://github.com/n8thangreen/simcovariates) package on GitHub. +[simcovariates](https://github.com/n8thangreen/simcovariates) package on +GitHub. ```{r, warning=FALSE, message=FALSE} library(dplyr) @@ -291,19 +292,21 @@ $$ \text{logit}(p_{t}) = \beta_0 + \beta_X (X_3 + X_4) + [\beta_{t} + \beta_{EM} (X_1 + X_2)] \; \text{I}(t \neq C) $$ -$\text{I}()$ is an indicator function taking value 1 if true and 0 otherwise. -That is, for treatment $C$ the right hand side becomes +$\text{I}()$ is an indicator function taking value 1 if true and 0 +otherwise. That is, for treatment $C$ the right hand side becomes $\beta_0 + \beta_X (X_3 + X_4)$ and for comparator treatments $A$ or $B$ there is an additional $\beta_t + \beta_{EM} (X_1 + X_2)$ component consisting of the effect modifier terms and the coefficient for the -treatment parameter, $\beta_t$ (or `b_trt` in the R code), i.e. the log odds-ratio (LOR) for the logit model. -Finally, $p_{t}$ is the probability of experiencing the event of interest for treatment $t$. +treatment parameter, $\beta_t$ (or `b_trt` in the R code), i.e. the log +odds-ratio (LOR) for the logit model. Finally, $p_{t}$ is the +probability of experiencing the event of interest for treatment $t$. ### Output statistics We will obtain the *marginal treatment effect* and *marginal variance*. -The definition by which of these are calculated depends on the type of data and outcome -scale. For our current example of binary data and log-odds ratio the marginal treatment effect is +The definition by which of these are calculated depends on the type of +data and outcome scale. For our current example of binary data and +log-odds ratio the marginal treatment effect is $$ \log\left( \frac{n_B/(N_B-n_B)}{n_C/(N_B-n_{B})} \right) = \log(n_B n_{\bar{C}}) - \log(n_C n_{\bar{B}}) @@ -315,16 +318,18 @@ $$ \frac{1}{n_C} + \frac{1}{n_{\bar{C}}} + \frac{1}{n_B} + \frac{1}{n_{\bar{B}}} $$ -where $n_B, n_C$ are the number of events in each arm and $\bar{C}$ -is the compliment of $C$, so e.g. $n_{\bar{C}} = N_C - n_c$. Other outcome scales will be discussed below. +where $n_B, n_C$ are the number of events in each arm and $\bar{C}$ is +the compliment of $C$, so e.g. $n_{\bar{C}} = N_C - n_c$. Other outcome +scales will be discussed below. ## Model fitting in R The `{outstandR}` package has been written to be easy to use and -essentially consists of a single function, `outstandR()`. This can be used -to run all of the different types of model, which when combined with their specific parameters -we will call *strategies*. The first two arguments of `outstandR()` are the -individual patient and aggregate-level data, respectively. +essentially consists of a single function, `outstandR()`. This can be +used to run all of the different types of model, which when combined +with their specific parameters we will call *strategies*. The first two +arguments of `outstandR()` are the individual patient and +aggregate-level data, respectively. A `strategy` argument of `outstandR` takes functions called `strategy_*()`, where the wildcard `*` is replaced by the name of the @@ -333,18 +338,17 @@ specific example is provided below. ### Model formula -We will take advantage of the in-built R formula object to define the models. -This will allow us easily pull out components of the object and consistently use it. -Defining $X_1, X_2$ as effect modifiers, $X_3, X_4$ as prognostic -variables and $Z$ the treatment indicator then the formula used in this -model is +We will take advantage of the in-built R formula object to define the +models. This will allow us easily pull out components of the object and +consistently use it. Defining $X_1, X_2$ as effect modifiers, $X_3, X_4$ +as prognostic variables and $Z$ the treatment indicator then the formula +used in this model is $$ y = X_3 + X_4 + Z + Z X_1 + Z X_2 -$$ -Notice that this does not include the link function of interest so appears as a linear regression. -This corresponds to the following `R` `formula` object passed as an -argument to the strategy function. +$$ Notice that this does not include the link function of interest so +appears as a linear regression. This corresponds to the following `R` +`formula` object passed as an argument to the strategy function. ```{r} lin_form <- as.formula("y ~ X3 + X4 + trt + trt:X1 + trt:X2") @@ -363,21 +367,24 @@ equivalent, but could be modified as follows. y ~ X3 + X4 + trt*(X1 + X2) - X1 - X2 ``` -We note that the MAIC approach does not strictly use a regression in the same way as the other methods so should not be considered directly comparable in this sense -but we have decided to use a consistent syntax across models using 'formula'. - +We note that the MAIC approach does not strictly use a regression in the +same way as the other methods so should not be considered directly +comparable in this sense but we have decided to use a consistent syntax +across models using 'formula'. ### Matching-Adjusted Indirect Comparison (MAIC) -A single call to `outstandR()` is sufficient to run the model. We pass to the `strategy` argument -the `strategy_maic()` function with arguments `formula = lin_form` as defined above and `family = binomial(link = "logit")` for binary data and logistic link. +A single call to `outstandR()` is sufficient to run the model. We pass +to the `strategy` argument the `strategy_maic()` function with arguments +`formula = lin_form` as defined above and +`family = binomial(link = "logit")` for binary data and logistic link. -Internally, using the individual patient level data for *AC* firstly we perform -non-parametric bootstrap of the `maic.boot` function with `R = 1000` -replicates. This function fits treatment coefficient for the marginal -effect for *A* vs *C*. The returned value is an object of class `boot` -from the `{boot}` package. We then calculate the bootstrap mean and -variance in the wrapper function `maic_boot_stats`. +Internally, using the individual patient level data for *AC* firstly we +perform non-parametric bootstrap of the `maic.boot` function with +`R = 1000` replicates. This function fits treatment coefficient for the +marginal effect for *A* vs *C*. The returned value is an object of class +`boot` from the `{boot}` package. We then calculate the bootstrap mean +and variance in the wrapper function `maic_boot_stats`. ```{r outstandR_maic} outstandR_maic <- @@ -397,7 +404,8 @@ We see that this is a list object with 2 parts. The first contains statistics between each pair of treatments. These are the mean contrasts, variances and confidence intervals (CI), respectively. The default CI is for 95% but can be altered in `outstandR` with the `CI` -argument. The second element of the list contains the absolute effect estimates. +argument. The second element of the list contains the absolute effect +estimates. A `print` method is available for `outstandR` objects for more human-readable output @@ -478,7 +486,8 @@ Simulated treatment comparison (STC) is the conventional outcome regression method. It involves fitting a regression model of outcome on treatment and covariates to the IPD. -We can simply pass the same formula as before to the modified call with `strategy_stc()`. +We can simply pass the same formula as before to the modified call with +`strategy_stc()`. ```{r outstandR_stc} outstandR_stc <- @@ -538,7 +547,8 @@ $$ \hat{\mu}_0 = \int_{x^*} g^{-1} (\hat{\beta}_0 + x^* \hat{\beta}_1 ) p(x^*) \; \text{d}x^* $$ -As performed for the previous approaches, call `outstandR()` but change the strategy to `strategy_gcomp_ml()`, +As performed for the previous approaches, call `outstandR()` but change +the strategy to `strategy_gcomp_ml()`, ```{r outstandR_gcomp_ml} outstandR_gcomp_ml <- @@ -598,7 +608,8 @@ full Bayesian estimation via Markov chain Monte Carlo (MCMC) sampling. The average, variance and interval estimates of the marginal treatment effect can be derived empirically from draws of the posterior density. -The strategy function to plug-in to the `outstandR()` call for this approach is `strategy_gcomp_stan()`, +The strategy function to plug-in to the `outstandR()` call for this +approach is `strategy_gcomp_stan()`, ```{r outstandR_gcomp_stan, message=FALSE, eval=FALSE} outstandR_gcomp_stan <- @@ -648,8 +659,9 @@ outstandR_gcomp_stan_lrr ### Multiple imputation marginalisation -The final method is to obtain the marginalized treatment effect for aggregate level data study, obtained -by integrating over the covariate distribution from the aggregate level data $BC$ study +The final method is to obtain the marginalized treatment effect for +aggregate level data study, obtained by integrating over the covariate +distribution from the aggregate level data $BC$ study $$ \Delta^{\text{marg}} = \mathbb{E}_{X \sim f_{\text{BC}}(X)} \left[ \mu_{T=1}(X) - \mu_{T=0}(X) \right] @@ -662,7 +674,8 @@ $$ \hat{\Delta}_{BC} \sim \mathcal{N}(\Delta^{\text{marg}}, SE^2) $$ -The multiple imputation marginalisation strategy function is `strategy_mim()`, +The multiple imputation marginalisation strategy function is +`strategy_mim()`, ```{r outstandR_mim, eval=FALSE} outstandR_mim <- @@ -710,13 +723,14 @@ xx <- capture.output( outstandR_mim_lrr ``` - ## Model comparison #### $AC$ effect in $BC$ population -The true $AC$ effect on the log OR scale in the $BC$ (aggregate trial data) population is -$\beta_t^{AC} + \beta_{EM} (\bar{X}^{AC}_1 + \bar{X}_2^{AC})$. Calculated by +The true $AC$ effect on the log OR scale in the $BC$ (aggregate trial +data) population is +$\beta_t^{AC} + \beta_{EM} (\bar{X}^{AC}_1 + \bar{X}_2^{AC})$. +Calculated by ```{r} mean_X1 <- ald_trial$value[ald_trial$statistic == "mean" & ald_trial$variable == "X1"]