From d42dd71b977a1f7637dec7397665cf68d016c072 Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Wed, 18 Sep 2024 02:15:32 -0400 Subject: [PATCH] Refactor interactive tooltips --- .../apps/r/calculate_interaction_zscores.R | 118 ++++++++---------- 1 file changed, 54 insertions(+), 64 deletions(-) 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"