From e193da0541f637775bb9683b81428567b87156e9 Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Thu, 12 Sep 2024 18:57:32 -0400 Subject: [PATCH] Use a single df for interaction calculations --- .../apps/r/calculate_interaction_zscores.R | 37 +++++++++---------- 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 7e0c7e2c..85d3e84d 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/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",