Quellcode durchsuchen

Use a single df for interaction calculations

Bryan Roessler vor 7 Monaten
Ursprung
Commit
e193da0541
1 geänderte Dateien mit 18 neuen und 19 gelöschten Zeilen
  1. 18 19
      qhtcp-workflow/apps/r/calculate_interaction_zscores.R

+ 18 - 19
qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -204,7 +204,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
     AUC = df %>% filter(conc_num_factor == 0) %>% pull(sd_AUC) %>% first()
   )
 
-  calculations <- df %>%
+  stats <- df %>%
     mutate(
       WT_L = df$mean_L,
       WT_K = df$mean_K,
@@ -232,7 +232,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       ) %>%
     ungroup()
 
-  calculations <- calculations %>%
+  stats <- stats %>%
     group_by(across(all_of(group_vars))) %>%
       mutate(
         Raw_Shift_L = mean_L[[1]] - bg_means$L,
@@ -245,7 +245,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
         Z_Shift_AUC = Raw_Shift_AUC[[1]] / bg_sd$AUC
       )
 
-  calculations <- calculations %>%
+  stats <- stats %>%
     mutate(
       Exp_L = WT_L + Raw_Shift_L,
       Exp_K = WT_K + Raw_Shift_K,
@@ -253,7 +253,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       Exp_AUC = WT_AUC + Raw_Shift_AUC
     )
 
-  calculations <- calculations %>%
+  stats <- stats %>%
     mutate(
       Delta_L = mean_L - Exp_L,
       Delta_K = mean_K - Exp_K,
@@ -261,7 +261,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       Delta_AUC = mean_AUC - Exp_AUC
     )
 
-  calculations <- calculations %>%
+  stats <- stats %>%
     mutate(
       Delta_L = if_else(NG == 1, mean_L - WT_L, Delta_L),
       Delta_K = if_else(NG == 1, mean_K - WT_K, Delta_K),
@@ -270,16 +270,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       Delta_L = if_else(SM == 1, mean_L - WT_L, Delta_L)
     )
 
-  lms <- calculations %>%
-    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 %>%
+  stats <- stats %>%
     mutate(
       Zscore_L = Delta_L / WT_sd_L,
       Zscore_K = Delta_K / WT_sd_K,
@@ -287,7 +278,15 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       Zscore_AUC = Delta_AUC / WT_sd_AUC
     )
 
-  interactions <- interactions %>%
+  lms <- stats %>%
+    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))
+    )
+
+  stats <- stats %>%
     left_join(lms, by = group_vars) %>%
     mutate(
       lm_Score_L = sapply(lm_L, function(model) coef(model)[2] * max_conc + coef(model)[1]),
@@ -304,7 +303,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
       Sum_Zscore_AUC = sum(Zscore_AUC, na.rm = TRUE)
     )
 
-  interactions <- interactions %>%
+  stats <- stats %>%
     mutate(
       Avg_Zscore_L = Sum_Zscore_L / num_non_removed_concs,
       Avg_Zscore_K = Sum_Zscore_K / num_non_removed_concs,
@@ -317,7 +316,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
     )
 
   # Declare column order for output
-  calculations <- calculations %>%
+  calculations <- stats %>%
     select("OrfRep", "Gene", "num", "conc_num", "conc_num_factor",
       "mean_L", "mean_K", "mean_r", "mean_AUC",
       "median_L", "median_K", "median_r", "median_AUC",
@@ -332,7 +331,7 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
     ungroup()
 
   # Also arrange results by Z_lm_L and NG
-  interactions <- interactions %>%
+  interactions <- stats %>%
     select("OrfRep", "Gene", "num", "Raw_Shift_L", "Raw_Shift_K",  "Raw_Shift_AUC", "Raw_Shift_r",
       "Z_Shift_L", "Z_Shift_K", "Z_Shift_r", "Z_Shift_AUC",
       "lm_Score_L", "lm_Score_K", "lm_Score_AUC", "lm_Score_r",