From 2f932b319ca81dccfa07fd59e1cdd1d6c08c71de Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Thu, 12 Sep 2024 18:46:47 -0400 Subject: [PATCH] Move linear models out of mutate() --- .../apps/r/calculate_interaction_zscores.R | 42 ++++++++++++------- 1 file changed, 26 insertions(+), 16 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 36f177a4..fac65ee0 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -248,12 +248,16 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c calculations <- calculations %>% mutate( Exp_L = WT_L + Raw_Shift_L, - Delta_L = mean_L - Exp_L, Exp_K = WT_K + Raw_Shift_K, - Delta_K = mean_K - Exp_K, Exp_r = WT_r + Raw_Shift_r, + Exp_AUC = WT_AUC + Raw_Shift_AUC + ) + + calculations <- calculations %>% + mutate( + Delta_L = mean_L - Exp_L, + Delta_K = mean_K - Exp_K, Delta_r = mean_r - Exp_r, - Exp_AUC = WT_AUC + Raw_Shift_AUC, Delta_AUC = mean_AUC - Exp_AUC ) @@ -266,12 +270,17 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c Delta_L = if_else(SM == 1, mean_L - WT_L, Delta_L) ) + lms <- df %>% + group_by(across(all_of(group_vars))) %>% + summarise( + lm_L = list(lm(Delta_L ~ conc_num_factor)), + lm_K = list(lm(Delta_K ~ conc_num_factor)), + lm_r = list(lm(Delta_r ~ conc_num_factor)), + lm_AUC = list(lm(Delta_AUC ~ conc_num_factor)) + ) + interactions <- calculations %>% mutate( - lm_L = lm(Delta_L ~ conc_num_factor), - lm_K = lm(Delta_K ~ conc_num_factor), - lm_r = lm(Delta_r ~ conc_num_factor), - lm_AUC = lm(Delta_AUC ~ conc_num_factor), Zscore_L = Delta_L / WT_sd_L, Zscore_K = Delta_K / WT_sd_K, Zscore_r = Delta_r / WT_sd_r, @@ -279,15 +288,16 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c ) interactions <- interactions %>% + left_join(lms, by = group_vars) %>% mutate( - lm_Score_L = max_conc * coef(lm_L)[2] + coef(lm_L)[1], - lm_Score_K = max_conc * coef(lm_K)[2] + coef(lm_K)[1], - lm_Score_r = max_conc * coef(lm_r)[2] + coef(lm_r)[1], - lm_Score_AUC = max_conc * coef(lm_AUC)[2] + coef(lm_AUC)[1], - r_squared_L = summary(lm_L)$r.squared, - r_squared_K = summary(lm_K)$r.squared, - r_squared_r = summary(lm_r)$r.squared, - r_squared_AUC = summary(lm_AUC)$r.squared, + lm_Score_L = sapply(lm_L, function(model) coef(model)[2] * max_conc + coef(model)[1]), + lm_Score_K = sapply(lm_K, function(model) coef(model)[2] * max_conc + coef(model)[1]), + lm_Score_r = sapply(lm_r, function(model) coef(model)[2] * max_conc + coef(model)[1]), + lm_Score_AUC = sapply(lm_AUC, function(model) coef(model)[2] * max_conc + coef(model)[1]), + r_squared_L = sapply(lm_L, function(model) summary(model)$r.squared), + r_squared_K = sapply(lm_K, function(model) summary(model)$r.squared), + r_squared_r = sapply(lm_r, function(model) summary(model)$r.squared), + r_squared_AUC = sapply(lm_AUC, function(model) summary(model)$r.squared), Sum_Zscore_L = sum(Zscore_L, na.rm = TRUE), Sum_Zscore_K = sum(Zscore_K, na.rm = TRUE), Sum_Zscore_r = sum(Zscore_r, na.rm = TRUE), @@ -335,7 +345,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c arrange(desc(NG)) %>% ungroup() - return(list(calculations = calculations, interactions = interaction)) + return(list(calculations = calculations, interactions = interactions)) } generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_layout = NULL) {