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

Try simpler df joining

Browse Source
This commit is contained in:
Bryan Roessler
2024-09-18 17:49:01 -04:00
parent d64d6d18cc
commit 1b7e5f6e5d
1 changed files with 42 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -281,7 +281,7 @@ calculate_interaction_scores <- function(df, max_conc) {
interactions <- stats %>% interactions <- stats %>%
group_by(across(all_of(group_vars))) %>% group_by(across(all_of(group_vars))) %>%
summarise( mutate(
OrfRep = first(OrfRep), OrfRep = first(OrfRep),
Gene = first(Gene), Gene = first(Gene),
num = first(num), num = first(num),
@@ -294,33 +294,47 @@ calculate_interaction_scores <- function(df, max_conc) {
Z_Shift_L = first(Z_Shift_L), Z_Shift_L = first(Z_Shift_L),
Z_Shift_K = first(Z_Shift_K), Z_Shift_K = first(Z_Shift_K),
Z_Shift_r = first(Z_Shift_r), Z_Shift_r = first(Z_Shift_r),
Z_Shift_AUC = first(Z_Shift_AUC), Z_Shift_AUC = first(Z_Shift_AUC)
)
# Summarise the data to calculate summary statistics
summary_stats <- interactions %>%
summarise(
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),
Sum_Zscore_AUC = sum(Zscore_AUC, na.rm = TRUE), Sum_Zscore_AUC = sum(Zscore_AUC, na.rm = TRUE),
lm_Score_L = max_conc * coef(lm_L)[2] + coef(lm_L)[1], lm_Score_L = max(conc_num) * coef(lm(Zscore_L ~ conc_num))[2] + coef(lm(Zscore_L ~ conc_num))[1],
lm_Score_K = max_conc * coef(lm_K)[2] + coef(lm_K)[1], lm_Score_K = max(conc_num) * coef(lm(Zscore_K ~ conc_num))[2] + coef(lm(Zscore_K ~ conc_num))[1],
lm_Score_r = max_conc * coef(lm_r)[2] + coef(lm_r)[1], lm_Score_r = max(conc_num) * coef(lm(Zscore_r ~ conc_num))[2] + coef(lm(Zscore_r ~ conc_num))[1],
lm_Score_AUC = max_conc * coef(lm_AUC)[2] + coef(lm_AUC)[1], lm_Score_AUC = max(conc_num) * coef(lm(Zscore_AUC ~ conc_num))[2] + coef(lm(Zscore_AUC ~ conc_num))[1],
R_Squared_L = summary(lm_L)$r.squared, R_Squared_L = summary(lm(Zscore_L ~ conc_num))$r.squared,
R_Squared_K = summary(lm_K)$r.squared, R_Squared_K = summary(lm(Zscore_K ~ conc_num))$r.squared,
R_Squared_r = summary(lm_r)$r.squared, R_Squared_r = summary(lm(Zscore_r ~ conc_num))$r.squared,
R_Squared_AUC = summary(lm_AUC)$r.squared, R_Squared_AUC = summary(lm(Zscore_AUC ~ conc_num))$r.squared,
lm_intercept_L = coef(lm_L)[1], lm_intercept_L = coef(lm(Zscore_L ~ conc_num))[1],
lm_slope_L = coef(lm_L)[2], lm_slope_L = coef(lm(Zscore_L ~ conc_num))[2],
lm_intercept_K = coef(lm_K)[1], lm_intercept_K = coef(lm(Zscore_K ~ conc_num))[1],
lm_slope_K = coef(lm_K)[2], lm_slope_K = coef(lm(Zscore_K ~ conc_num))[2],
lm_intercept_r = coef(lm_r)[1], lm_intercept_r = coef(lm(Zscore_r ~ conc_num))[1],
lm_slope_r = coef(lm_r)[2], lm_slope_r = coef(lm(Zscore_r ~ conc_num))[2],
lm_intercept_AUC = coef(lm_AUC)[1], lm_intercept_AUC = coef(lm(Zscore_AUC ~ conc_num))[1],
lm_slope_AUC = coef(lm_AUC)[2], lm_slope_AUC = coef(lm(Zscore_AUC ~ conc_num))[2],
NG = sum(NG, na.rm = TRUE), NG = sum(NG, na.rm = TRUE),
DB = sum(DB, na.rm = TRUE), DB = sum(DB, na.rm = TRUE),
SM = sum(SM, na.rm = TRUE), SM = sum(SM, na.rm = TRUE),
.groups = "keep" .groups = "keep"
) )
# Join the summary data back to the original data
cleaned_interactions <- interactions %>%
select(-any_of(intersect(names(interactions), names(summary_stats))))
interactions_joined <- left_join(cleaned_interactions, summary_stats, by = group_vars)
interactions_joined <- interactions_joined %>% distinct()
# Remove duplicate rows if necessary
interactions <- interactions %>% distinct()
num_non_removed_concs <- total_conc_num - sum(stats$DB, na.rm = TRUE) - 1 num_non_removed_concs <- total_conc_num - sum(stats$DB, na.rm = TRUE) - 1
interactions <- interactions %>% interactions <- interactions %>%
@@ -353,10 +367,12 @@ calculate_interaction_scores <- function(df, max_conc) {
"Zscore_L", "Zscore_K", "Zscore_r", "Zscore_AUC", "Zscore_L", "Zscore_K", "Zscore_r", "Zscore_AUC",
"NG", "SM", "DB") "NG", "SM", "DB")
calculations_joined <- df %>% select(-any_of(setdiff(names(calculations), c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor")))) calculations_joined <- df %>%
select(-any_of(intersect(names(df), names(calculations))))
calculations_joined <- left_join(calculations_joined, calculations, by = c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor")) calculations_joined <- left_join(calculations_joined, calculations, by = c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor"))
interactions_joined <- df %>% select(-any_of(setdiff(names(interactions), c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor")))) interactions_joined <- df %>%
select(-any_of(intersect(names(df), names(interactions))))
interactions_joined <- left_join(interactions_joined, interactions, by = c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor")) interactions_joined <- left_join(interactions_joined, interactions, by = c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor"))
return(list(calculations = calculations, interactions = interactions, interactions_joined = interactions_joined, return(list(calculations = calculations, interactions = interactions, interactions_joined = interactions_joined,
@@ -1234,7 +1250,7 @@ main <- function() {
# TODO trying out some parallelization # TODO trying out some parallelization
# future::plan(future::multicore, workers = parallel::detectCores()) # future::plan(future::multicore, workers = parallel::detectCores())
future::plan(future::multicore, workers = 3) future::plan(future::multisession, workers = 3)
plot_configs <- list( plot_configs <- list(
list(out_dir = out_dir_qc, filename = "L_vs_K_before_quality_control", list(out_dir = out_dir_qc, filename = "L_vs_K_before_quality_control",
@@ -1257,19 +1273,10 @@ main <- function() {
plot_configs = delta_bg_outside_2sd_k_plot_configs) plot_configs = delta_bg_outside_2sd_k_plot_configs)
) )
furrr::future_map(plot_configs, function(config) { # Generating quality control plots in parallel
generate_and_save_plots(config$out_dir, config$filename, config$plot_configs) # furrr::future_map(plot_configs, function(config) {
}, .options = furrr_options(seed = TRUE)) # generate_and_save_plots(config$out_dir, config$filename, config$plot_configs)
# }, .options = furrr_options(seed = TRUE))
# generate_and_save_plots(out_dir_qc, "L_vs_K_before_quality_control", l_vs_k_plots)
# generate_and_save_plots(out_dir_qc, "frequency_delta_background", frequency_delta_bg_plots)
# generate_and_save_plots(out_dir_qc, "L_vs_K_above_threshold", above_threshold_plots)
# generate_and_save_plots(out_dir_qc, "plate_analysis", plate_analysis_plot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_boxplots", plate_analysis_boxplot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros", plate_analysis_no_zeros_plot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros_boxplots", plate_analysis_no_zeros_boxplot_configs)
# generate_and_save_plots(out_dir_qc, "L_vs_K_for_strains_2SD_outside_mean_K", l_outside_2sd_k_plots)
# generate_and_save_plots(out_dir_qc, "delta_background_vs_K_for_strains_2sd_outside_mean_K", delta_bg_outside_2sd_k_plots)
# Process background strains # Process background strains
bg_strains <- c("YDL227C") bg_strains <- c("YDL227C")
@@ -1435,7 +1442,7 @@ main <- function() {
message("Filtering and reranking plots") message("Filtering and reranking plots")
# Formerly X_NArm # Formerly X_NArm
zscores_interactions_filtered <- zscores_interactions_joined %>% zscores_interactions_filtered <- zscores_interactions_joined %>%
filter(!is.na(Z_lm_L) | !is.na(Avg_Zscore_L)) %>% filter(!is.na(Z_lm_L) & !is.na(Avg_Zscore_L)) %>%
mutate( mutate(
Overlap = case_when( Overlap = case_when(
Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both", Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both",