Refactor interactive tooltips

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, "<br>Gene:", df$Gene, "<br>delta_bg:", df$delta_bg)
+      } else if (!is.null(config$gene_point) && config$gene_point) {
+        tooltip_text <- paste("OrfRep:", df$OrfRep, "<br>Gene:", df$Gene)
       } else {
-        aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
+        tooltip_text <- paste("x:", df[[config$x_var]], "<br>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"