diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R
index 7e0e0311..2e14c5df 100644
--- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R
+++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R
@@ -370,18 +370,29 @@ generate_and_save_plots <- function(out_dir, file_name, plot_configs, grid_layou
config <- plot_configs[[i]]
df <- config$df
- # Build the aes_mapping based on config
- aes_mapping <- if (is.null(config$color_var)) {
- if (is.null(config$y_var)) {
- aes(x = .data[[config$x_var]])
+ # Define aes_mapping based on plot type
+ if (config$plot_type == "scatter") {
+ if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
+ tooltip_text <- paste("OrfRep:", df$OrfRep, "
Gene:", df$Gene, "
delta_bg:", df$delta_bg)
+ } else if (!is.null(config$gene_point) && config$gene_point) {
+ tooltip_text <- paste("OrfRep:", df$OrfRep, "
Gene:", df$Gene)
} else {
- aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
+ tooltip_text <- paste("x:", df[[config$x_var]], "
y:", df[[config$y_var]])
+ }
+
+ aes_mapping <- if (is.null(config$color_var)) {
+ aes(x = .data[[config$x_var]], y = .data[[config$y_var]], text = tooltip_text)
+ } else {
+ aes(x = .data[[config$x_var]], y = .data[[config$y_var]],
+ color = as.factor(.data[[config$color_var]]), text = tooltip_text)
}
} else {
- if (is.null(config$y_var)) {
- aes(x = .data[[config$x_var]], color = as.factor(.data[[config$color_var]]))
+ # Define aes_mapping for other plot types without 'text' aesthetic
+ aes_mapping <- if (is.null(config$color_var)) {
+ aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
} else {
- aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = as.factor(.data[[config$color_var]]))
+ aes(x = .data[[config$x_var]], y = .data[[config$y_var]],
+ color = as.factor(.data[[config$color_var]]))
}
}
@@ -413,14 +424,16 @@ generate_and_save_plots <- function(out_dir, file_name, plot_configs, grid_layou
plot <- plot + ylab(config$y_label)
}
- # Add interactive tooltips for plotly plots
- tooltip_vars <- c()
+ # Convert to plotly object
if (config$plot_type == "scatter") {
- tooltip_vars <- c(config$x_var, config$y_var)
+ plotly_plot <- ggplotly(plot, tooltip = "text")
+ } else {
+ # For non-scatter plots, decide if tooltips are needed
+ # If not, you can set tooltip to NULL or specify relevant aesthetics
+ plotly_plot <- ggplotly(plot, tooltip = "none")
}
- # Convert to plotly object
- plotly_plot <- ggplotly(plot, tooltip = tooltip_vars)
+ # Adjust legend position if specified
if (!is.null(config$legend_position) && config$legend_position == "bottom") {
plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h"))
}
@@ -917,14 +930,13 @@ generate_correlation_plot_configs <- function(df) {
return(configs)
}
-
filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FALSE,
rank = FALSE, limits_map = NULL, verbose = TRUE) {
-
+
avg_zscore_cols <- paste0("Avg_Zscore_", variables)
z_lm_cols <- paste0("Z_lm_", variables)
-
- # Adjust NAs to .001 for linear model
+
+ # Step 1: Adjust NAs to 0.001 for linear model (if adjust = TRUE)
if (adjust) {
if (verbose) message("Replacing NA with 0.001 for Avg_Zscore_ and Z_lm_ columns")
df <- df %>%
@@ -933,57 +945,30 @@ filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FAL
across(all_of(z_lm_cols), ~ ifelse(is.na(.), 0.001, .))
)
}
-
+
# Filter non-finite values
if (nf) {
- non_finite_df <- df %>%
- filter(if_any(all_of(variables), ~ !is.finite(.)))
-
- if (verbose && nrow(non_finite_df) > 0) {
- message("Filtering non-finite rows for variable(s) ", paste(variables, collapse = ", "), ":")
- print(non_finite_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
- }
-
df <- df %>%
filter(if_all(all_of(variables), ~ is.finite(.)))
}
-
+
# Filter missing values
if (missing) {
-
- missing_df <- df %>%
- filter(if_any(all_of(variables), ~ is.na(.)))
-
- if (verbose && nrow(missing_df) > 0) {
- message("Filtering missing data for variable(s) ", paste(variables, collapse = ", "), ":")
- print(missing_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
- }
-
df <- df %>%
filter(if_all(all_of(variables), ~ !is.na(.)))
}
-
- # Apply Limits from 'limits_map' if provided
+
+ # Apply limits from 'limits_map' if provided
if (!is.null(limits_map)) {
for (variable in names(limits_map)) {
if (variable %in% variables) {
ylim_vals <- limits_map[[variable]]
-
- out_of_range_df <- df %>%
- filter(.data[[variable]] < ylim_vals[1] | .data[[variable]] > ylim_vals[2])
-
- if (verbose && nrow(out_of_range_df) > 0) {
- message("Applying limits for variable ", variable, ": [", ylim_vals[1], ", ", ylim_vals[2], "].")
- message("Filtering out-of-range data for variable ", variable, ":")
- print(out_of_range_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
- }
-
df <- df %>%
filter(.data[[variable]] >= ylim_vals[1] & .data[[variable]] <= ylim_vals[2])
}
}
}
-
+
# Calculate and add rank columns
if (rank) {
if (verbose) message("Calculating ranks for variable(s): ", paste(variables, collapse = ", "))
@@ -1002,6 +987,7 @@ filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FAL
return(df)
}
+
main <- function() {
lapply(names(args$experiments), function(exp_name) {
exp <- args$experiments[[exp_name]]
@@ -1197,16 +1183,16 @@ main <- function() {
)
)
- # message("Generating quality control plots")
- # 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)
+ message("Generating quality control plots")
+ 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
bg_strains <- c("YDL227C")
@@ -1370,10 +1356,12 @@ main <- function() {
plot_configs = rank_lm_plot_configs, grid_layout = list(ncol = 3, nrow = 2))
message("Filtering and reranking plots")
- # Formerly X_NArm
+ # Filter out rows where both Z_lm_L and Avg_Zscore_L are NA
zscores_interactions_filtered <- zscores_interactions_joined %>%
- group_by(across(all_of(c("OrfRep", "Gene", "num")))) %>%
- filter(!is.na(Z_lm_L) | !is.na(Avg_Zscore_L)) %>%
+ filter(!is.na(Z_lm_L) | !is.na(Avg_Zscore_L))
+
+ # Formerly X_NArm
+ zscores_interactions_filtered <- zscores_interactions_filtered %>%
mutate(
lm_R_squared_L = if (n() > 1) summary(lm(Z_lm_L ~ Avg_Zscore_L))$r.squared else NA,
lm_R_squared_K = if (n() > 1) summary(lm(Z_lm_K ~ Avg_Zscore_K))$r.squared else NA,
@@ -1382,8 +1370,10 @@ main <- function() {
Overlap = case_when(
Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both",
Z_lm_L <= -2 & Avg_Zscore_L <= -2 ~ "Deletion Suppressor Both",
- Z_lm_L >= 2 & Avg_Zscore_L < 2 ~ "Deletion Enhancer lm only",
- Z_lm_L <= -2 & Avg_Zscore_L > -2 ~ "Deletion Suppressor lm only",
+ Z_lm_L >= 2 & Avg_Zscore_L <= 2 ~ "Deletion Enhancer lm only",
+ Z_lm_L <= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Avg Zscore only",
+ Z_lm_L <= -2 & Avg_Zscore_L >= -2 ~ "Deletion Suppressor lm only",
+ Z_lm_L >= -2 & Avg_Zscore_L <= -2 ~ "Deletion Suppressor Avg Zscore only",
Z_lm_L >= 2 & Avg_Zscore_L <= -2 ~ "Deletion Enhancer lm, Deletion Suppressor Avg Z score",
Z_lm_L <= -2 & Avg_Zscore_L >= 2 ~ "Deletion Suppressor lm, Deletion Enhancer Avg Z score",
TRUE ~ "No Effect"