bryan/hartman-server
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move linear models out of mutate()

Browse Source
This commit is contained in:
Bryan Roessler
2024-09-12 18:46:47 -04:00
parent 9f87b54727
commit 2f932b319c
1 changed files with 26 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
qhtcp-workflow/apps/r/calculate_interaction_zscores.R
View File

@@ -248,12 +248,16 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
calculations <- calculations %>% calculations <- calculations %>%
mutate( mutate(
Exp_L = WT_L + Raw_Shift_L, Exp_L = WT_L + Raw_Shift_L,
Delta_L = mean_L - Exp_L,
Exp_K = WT_K + Raw_Shift_K, Exp_K = WT_K + Raw_Shift_K,
Delta_K = mean_K - Exp_K,
Exp_r = WT_r + Raw_Shift_r, 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, Delta_r = mean_r - Exp_r,
Exp_AUC = WT_AUC + Raw_Shift_AUC,
Delta_AUC = mean_AUC - Exp_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) 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 %>% interactions <- calculations %>%
mutate( 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_L = Delta_L / WT_sd_L,
Zscore_K = Delta_K / WT_sd_K, Zscore_K = Delta_K / WT_sd_K,
Zscore_r = Delta_r / WT_sd_r, Zscore_r = Delta_r / WT_sd_r,
@@ -279,15 +288,16 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
) )
interactions <- interactions %>% interactions <- interactions %>%
left_join(lms, by = group_vars) %>%
mutate( mutate(
lm_Score_L = max_conc * coef(lm_L)[2] + coef(lm_L)[1], lm_Score_L = sapply(lm_L, function(model) coef(model)[2] * max_conc + coef(model)[1]),
lm_Score_K = max_conc * coef(lm_K)[2] + coef(lm_K)[1], lm_Score_K = sapply(lm_K, function(model) coef(model)[2] * max_conc + coef(model)[1]),
lm_Score_r = max_conc * coef(lm_r)[2] + coef(lm_r)[1], lm_Score_r = sapply(lm_r, function(model) coef(model)[2] * max_conc + coef(model)[1]),
lm_Score_AUC = max_conc * coef(lm_AUC)[2] + coef(lm_AUC)[1], lm_Score_AUC = sapply(lm_AUC, function(model) coef(model)[2] * max_conc + coef(model)[1]),
r_squared_L = summary(lm_L)$r.squared, r_squared_L = sapply(lm_L, function(model) summary(model)$r.squared),
r_squared_K = summary(lm_K)$r.squared, r_squared_K = sapply(lm_K, function(model) summary(model)$r.squared),
r_squared_r = summary(lm_r)$r.squared, r_squared_r = sapply(lm_r, function(model) summary(model)$r.squared),
r_squared_AUC = summary(lm_AUC)$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_L = sum(Zscore_L, na.rm = TRUE),
Sum_Zscore_K = sum(Zscore_K, na.rm = TRUE), Sum_Zscore_K = sum(Zscore_K, na.rm = TRUE),
Sum_Zscore_r = sum(Zscore_r, 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)) %>% arrange(desc(NG)) %>%
ungroup() 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) { generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_layout = NULL) {