Nothing
#' @importFrom rlang .data
NULL
## Synergy Calculation using LMM
#' @importFrom marginaleffects hypotheses
#' @import stats
#'
#' @title Synergy calculation using linear-mixed models
#' @description
#' `lmmSynergy` allows for the calculation of synergy using 3 different references models: Bliss independence, highest single agent and
#' response additivity. The calculation of synergy is based on hypothesis testing on the coefficient estimates from the model fitted by
#' [`lmmModel()`].
#' @param model An object of class "lme" representing the linear mixed-effects model fitted by [`lmmModel()`].
#' @param method String indicating the method for synergy calculation. Possible methods are "Bliss", "HSA" and "RA",
#' corresponding to Bliss, highest single agent and response additivity, respectively.
#' @param min_time Minimun time for which to start calculating synergy.
#' @param robust If TRUE, uncertainty is estimated using sandwich-based robust estimators
#' of the variance-covariance matrix of the regression coefficient estimates provided by [clubSandwich::vcovCR.lme].
#' @param type Character string specifying which small-sample adjustment should be used, with available options "CR0", "CR1", "CR1p", "CR1S", "CR2", or "CR3".
#' See "Details" section of [clubSandwich::vcovCR()] for further information.
#' @param ra_nsim Number of random sampling to calculate the synergy for Response Additivity model.
#' @param show_plot Logical indicating if a plot with the results of the synergy calculation should be generated.
#' @param ... Additional arguments to be passed to [marginaleffects::hypotheses()].
#' @details
#' `lmmSynergy` uses the statistical description provided by Demidenko and Miller (2019) for the calculation of synergy. It is based on hypothesis testing
#' on the coefficients estimates from the model fitted by [`lmmModel()`]: \eqn{\hat{\beta}_C}, \eqn{\hat{\beta}_A}, \eqn{\hat{\beta}_B}, \eqn{\hat{\beta}_{AB}},
#' which represent the estimated specific growth rates for the Control, Drug A, Drug B and Combination groups, respectively.
#'
#' **Bliss Indepence Model**
#'
#' For Bliss model, `lmmSynergy` test the following null hypothesis:
#'
#' _Two-drugs combination experiment_:
#' \deqn{H_0: \beta_{combination} = \beta_A + \beta_B - \beta_{control}}
#'
#' _Three-drugs combination experiment_:
#' \deqn{H_0: \beta_{combination} = \beta_A + \beta_B + \beta_C - 2\beta_{control}}
#'
#' **Highes Single Agent (HSA)**
#'
#' _Two-drugs combination experiment_:
#' For the HSA model, `lmmSynergy` test the following null hypothesis:
#' \deqn{H_0: \beta_{combination} = \min(\beta_A, \beta_B)}
#'
#' _Three-drugs combination experiment_:
#' For the HSA model, `lmmSynergy` test the following null hypothesis:
#' \deqn{H_0: \beta_{combination} = \min(\beta_A, \beta_B, \beta_C)}
#'
#' **Response Additivity (RA)**
#'
#' For the RA model, `lmmSynergy` test the following null hypothesis:
#'
#' _Two-drugs combination experiment_:
#' \deqn{H_0: e^{\beta_{combination}t} = e^{\beta_At}+e^{\beta_Bt}-e^{\beta_{control}t}}
#'
#' _Three-drugs combination experiment_:
#' \deqn{H_0: e^{\beta_{combination}t} = e^{\beta_At}+e^{\beta_Bt}+e^{\beta_Ct}-2e^{\beta_{control}t}}
#'
#' For **Bliss** and **HSA** models, `lmmSynergy` uses [marginaleffects::hypotheses()] to conduct hypothesis tests on the estimated coefficients of the model.
#'
#' In the case of the **RA** model, the null hypothesis is tested comparing the area under the curve (i.e. cumulative effect from the beginning of a treatment to
#' a time point of interest) obtained from each side of the equation for the null hypothesis, based on `ra_sim` random samplings from the
#' distribution of the coefficients.
#'
#' **Combination Index and Synergy Score**
#'
#' The results obtained by `lmmSynergy` include the synergy score (SS) and combination index (CI) for the model, for each time point, together with their confidence interval,
#' and the corresponding p-value. The values of SS and CI provided by `lmmSynergy` follow previous definitions of these metrics so they have the same interpretation:
#'
#' - The SS has been defined as the excess response due to drug interaction compared to the reference model (Ianevski et al. (2017), Ianevski, Giri, and Aittokallio (2022), Mao and Guo (2023)).
#' Following this definition, a \eqn{SS>0}, \eqn{SS=0}, and \eqn{SS<0}, represent synergistic, additive and antagonistic effects, respectively.
#'
#' - According to the common definition of the CI, a \eqn{CI<1}, \eqn{CI=1}, and \eqn{CI>1} represent synergistic, additive and antagonistic effects, respectively (Yadav et al. (2015), Demidenko and Miller (2019),
#' Mao and Guo (2023)), and provides information about the observed drug combination effect versus the expected additive effect provided by the reference synergy model.
#' A drug combination effect larger than the expected (\eqn{CI > 1}) would indicate synergism, a drug combination effect equal to the expected (\eqn{CI = 1}) would indicate additivity,
#' and a lower drug combination effect than the expected (\eqn{CI < 1}) would indicate antagonism.
#'
#' As mentioned above, the results include the synergy results for **each day**. This means that `lmmSynergy` refits the model using the data from `time_start` defined in [lmmModel()] until
#' each time point, providing the synergy results for each of these models and for that specific time point.
#'
#' **Uncertainty estimation using robust estimators**
#'
#' If `robust = TRUE`, `lmmSynergy` deals with possible model misspecifications, allowing for cluster-robust variance estimation using [clubSandwich::vcovCR.lme].
#' When using `robust = TRUE`, setting `type = "CR2"` is recommended. See more details in [clubSandwich::vcovCR()].
#'
#' _Note_: When a variance structure has been specified in the model it is recommended to use always `robust = TRUE` to get a better estimation.
#'
#' @returns The function returns a list with two elements:
#' - `Constrasts`: List with the outputs of the linear test for the synergy null hypothesis obtained by [marginaleffects::hypotheses()] for each time.
#' See [marginaleffects::hypotheses()] for more details.
#' - `Synergy`: Data frame with the synergy results, indicating the model of synergy ("Bliss", "HSA" or "RA"), the metric (combination index and synergy score),
#' the value of the metric estimate (with upper and lower confidence interval bounds) and the p-value, for each time.
#'
#' If `show_plot = TRUE`, a plot with the synergy results obtained with [plot_lmmSynergy()] is also shown.
#' @references
#' - Demidenko, Eugene, and Todd W. Miller. 2019. _Statistical Determination of Synergy Based on Bliss Definition of Drugs Independence._ PLoS ONE 14 (November). https://doi.org/10.1371/journal.pone.0224137.
#' - Yadav, Bhagwan, Krister Wennerberg, Tero Aittokallio, and Jing Tang. 2015. _Searching for Drug Synergy in Complex Dose–Response Landscapes Using an Interaction Potency Model._ Computational and Structural Biotechnology Journal 13: 504–13. https://doi.org/10.1016/j.csbj.2015.09.001.
#' - Ianevski, Aleksandr, Liye He, Tero Aittokallio, and Jing Tang. 2017. _SynergyFinder: A Web Application for Analyzing Drug Combination Dose–Response Matrix Data._ Bioinformatics 33 (August): 2413–15. https://doi.org/10.1093/bioinformatics/btx162.
#' - Ianevski, Aleksandr, Anil K Giri, and Tero Aittokallio. 2022. _SynergyFinder 3.0: An Interactive Analysis and Consensus Interpretation of Multi-Drug Synergies Across Multiple Samples._ Nucleic Acids Research 50 (July): W739–43. https://doi.org/10.1093/nar/gkac382.
#' - Mao, Binchen, and Sheng Guo. 2023. _Statistical Assessment of Drug Synergy from in Vivo Combination Studies Using Mouse Tumor Models._ Cancer Research Communications 3 (October): 2146–57. https://doi.org/10.1158/2767-9764.CRC-23-0243.
#' - Vincent Arel-Bundock, Noah Greifer, and Andrew Heiss. Forthcoming. How to Interpret Statistical Models Using marginaleffects in R and Python. Journal of Statistical Software. https://marginaleffects.com
#' @examples
#' # Load the example data
#' data(grwth_data)
#' # Fit the model
#' lmm <- lmmModel(
#' data = grwth_data,
#' sample_id = "subject",
#' time = "Time",
#' treatment = "Treatment",
#' tumor_vol = "TumorVolume",
#' trt_control = "Control",
#' drug_a = "DrugA",
#' drug_b = "DrugB",
#' combination = "Combination"
#' )
#' # Most simple use with default values
#' syn <- lmmSynergy(lmm)
#' # Accessing to synergy results data frame
#' syn$Synergy
#' # Selecting different reference models:
#' ## Bliss
#' lmmSynergy(lmm, method = "Bliss")
#' ## HSA
#' lmmSynergy(lmm, method = "HSA")
#' ## RA
#' lmmSynergy(lmm, method = "RA", ra_sim = 1000)
#'
#' # Only calculate synergy from Time 12 onwards
#' lmmSynergy(lmm, min_time = 12)
#'
#' # Using robust standard errors
#' lmmSynergy(lmm, method = "Bliss", robust = TRUE, type = "CR2")
#'
#' @export
lmmSynergy <- function(model,
method = "Bliss",
min_time = 0,
robust = FALSE,
type = "CR2",
ra_nsim = 1000,
show_plot = TRUE,
...) {
# Validate method input
valid_methods <- c("Bliss", "HSA", "RA")
if (!method %in% valid_methods) {
stop("Invalid 'method' provided. Choose from 'Bliss', 'HSA', or 'RA'.")
}
ss <- data.frame()
ci <- data.frame()
Contrasts <- list()
fixef_betas <- nlme::fixef(model)
if(method == "RA") {
# Function to compute LHS AUC
lhs_auc <- function(beta_AB) {
integrate(function(t)
exp(beta_AB * t), t1, t2)$value
}
# Function to compute RHS AUC
# 3 drugs
rhs_auc3 <- function(beta_A, beta_B, beta_Z, beta_C) {
integrate(function(t) {
(exp(beta_A * t) + exp(beta_B * t) + exp(beta_Z * t) - 2*exp(beta_C * t))
}, t1, t2)$value
}
# 2 drugs
rhs_auc <- function(beta_A, beta_B, beta_C) {
integrate(function(t) {
(exp(beta_A * t) + exp(beta_B * t) - exp(beta_C * t))
}, t1, t2)$value
}
# Define initial time point for RA calculation
t1 <- min(model$dt1$Time)
# Times to calculate synergy
times <- unique(model$data$Time)
times <- times[times >= min_time]
times <- times[order(times)]
Contrasts <- NULL
i <- 1
for (d in times) {
data <- model$data %>% dplyr::filter(.data$Time <= d)
model_time <- update(model, data = data)
# Define final time point for each model
t2 <- d
if (robust) {
cluster_robust_vcov <- clubSandwich::vcovCR(model_time, type = type) # Cluster-robust variance-covariance matrix
betas <- fixef(model_time) # model betas estimates
betas_mvnorm <- MASS::mvrnorm(n = ra_nsim, mu = betas, Sigma = cluster_robust_vcov) # Simulate from the multivariate normal distribution
b1 <- betas_mvnorm[,1]
b2 <- betas_mvnorm[,2]
b3 <- betas_mvnorm[,3]
if (length(fixef_betas) == 5){
b4 <- betas_mvnorm[,4]
b5 <- betas_mvnorm[,5]
# Compute AUC for each simulation sample
lhs_aucs <- sapply(b5, lhs_auc)
rhs_aucs <- mapply(rhs_auc3, beta_A = b2, beta_B = b3, beta_Z = b4, beta_C = b1)
} else {
b4 <- betas_mvnorm[,4]
# Compute AUC for each simulation sample
lhs_aucs <- sapply(b4, lhs_auc)
rhs_aucs <- mapply(rhs_auc, beta_A = b2, beta_B = b3, beta_C = b1)
}
# Compute the difference in AUCs
delta_aucs <- lhs_aucs - rhs_aucs
ratio_aucs <- lhs_aucs/rhs_aucs
ratio_aucs[which(ratio_aucs<0)] <- max(ratio_aucs) + 1
# Estimates
delta <- median(delta_aucs)
ratio <- median(ratio_aucs)
sd_delta <- sd(delta_aucs)
# 95% Confidence interval
ci_delta <- quantile(delta_aucs, c(0.025, 0.975))
ci_ratio <- quantile(ratio_aucs, c(0.025, 0.975))
# p-value (two-tailed test)
p_delta <- 2 * min(mean(delta_aucs <= 0), mean(delta_aucs >= 0))
p_ratio <- 2 * min(mean(ratio_aucs <= 1), mean(ratio_aucs >= 1))
} else {
vcov_mtx <- vcov(model_time) # Variance-Covariance Matrix for the Fitted Model Object
betas <- fixef(model_time) # model betas estimates
betas_mvnorm <- MASS::mvrnorm(n = ra_nsim, mu = betas, Sigma = vcov_mtx) # Simulate from the multivariate normal distribution
b1 <- betas_mvnorm[,1]
b2 <- betas_mvnorm[,2]
b3 <- betas_mvnorm[,3]
if (length(fixef_betas) == 5){
b4 <- betas_mvnorm[,4]
b5 <- betas_mvnorm[,5]
# Compute AUC for each simulation sample
lhs_aucs <- sapply(b5, lhs_auc)
rhs_aucs <- mapply(rhs_auc3, beta_A = b2, beta_B = b3, beta_Z = b4, beta_C = b1)
} else {
b4 <- betas_mvnorm[,4]
# Compute AUC for each simulation sample
lhs_aucs <- sapply(b4, lhs_auc)
rhs_aucs <- mapply(rhs_auc, beta_A = b2, beta_B = b3, beta_C = b1)
}
# Compute the difference in AUCs
delta_aucs <- lhs_aucs - rhs_aucs
ratio_aucs <- lhs_aucs/rhs_aucs
ratio_aucs[which(ratio_aucs<0)] <- max(ratio_aucs) + 1
# Estimates
delta <- median(delta_aucs)
ratio <- median(ratio_aucs)
sd_delta <- sd(delta_aucs)
# 95% Confidence interval
ci_delta <- quantile(delta_aucs, c(0.025, 0.975))
ci_ratio <- quantile(ratio_aucs, c(0.025, 0.975))
# p-value (two-tailed test)
p_delta <- 2 * min(mean(delta_aucs <= 0), mean(delta_aucs >= 0))
p_ratio <- 2 * min(mean(ratio_aucs <= 1), mean(ratio_aucs >= 1))
}
ss <- rbind(ss,
data.frame(
method,
"SS",
- delta/sd_delta,
- ci_delta[2]/sd_delta,
- ci_delta[1]/sd_delta,
p_delta,
d
))
ci <- rbind(ci, data.frame(
method,
"CI",
ratio,
ci_ratio[1],
ci_ratio[2],
p_ratio,
d
))
i <- i + 1
}
} else {
if (method == "Bliss") {
if (length (fixef_betas) == 5) {
contrast <- "b5 = b2 + b3 + b4 - 2*b1"
} else {
contrast <- "b4 = b2 + b3 - b1"
}
}
if (method == "HSA") {
if (length(fixef_betas) == 5) {
if (which.min(fixef_betas[2:4]) == 1) {
contrast <- "b5 = b2"
} else if (which.min(fixef_betas[2:4]) == 2){
contrast <- "b5 = b3"
} else {
contrast <- "b5 = b4"
}
} else {
if (which.min(fixef_betas[2:3]) == 1) {
contrast <- "b4 = b2"
} else{
contrast <- "b4 = b3"
}
}
}
times <- unique(model$data$Time)
times <- times[times >= min_time]
times <- times[order(times)]
i <- 1
for (d in times) {
data <- model$data %>% dplyr::filter(.data$Time <= d)
model_time <- update(model, data = data)
if (robust) {
Test <- hypotheses(
model_time,
hypothesis = contrast,
vcov = clubSandwich::vcovCR(model_time, type = type),
...
)
} else {
Test <- hypotheses(model_time, hypothesis = contrast, ...)
}
ss <- rbind(ss,
data.frame(
method,
"SS",
- (Test$estimate)/(Test$std.error),
- (Test$conf.high)/(Test$std.error),
- (Test$conf.low)/(Test$std.error),
Test$p.value,
d
))
ci <- rbind(ci, data.frame(
method,
"CI",
exp(Test$estimate*d),
exp(Test$conf.low*d),
exp(Test$conf.high*d),
Test$p.value,
d
))
Contrasts[[i]] <- Test
i <- i + 1
}
names(Contrasts) <- paste("Time", times, sep = "")
}
colnames(ci) <- c("Model", "Metric", "Estimate", "lwr", "upr", "pval", "Time")
colnames(ss) <- c("Model", "Metric", "Estimate", "lwr", "upr", "pval", "Time")
df <- rbind(ci, ss)
rownames(df) <- NULL
if (sum(df$pval == 0) > 0) {
ndec <- nchar(strsplit(as.character(min(df$pval[df$pval!=0])), "\\.")[[1]][2])
apx_p <- paste("p<",ndec/ndec*10^-(ndec), sep = "")
warning(paste("p-values below", apx_p, "are approximated to 0."),
" If you used method = 'RA' consider increasing ra_nsim value for",
" more precise p-values.")
}
result <- list(Contrasts = Contrasts, Synergy = df)
if(show_plot) {
plot(plot_lmmSynergy(result)$CI_SS)
}
attr(result, "SynergyLMM") <- "lmmSynergy"
return(result)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.