Move linear models out of mutate()

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) {