Plot interaction plots in chunks of 12 for pagination

qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -683,7 +683,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
         ncol = grid_layout$ncol,
         nrow = grid_layout$nrow
       )
-      grid.newpage()
+      # grid.newpage()
     }
   }
 
@@ -919,13 +919,13 @@ generate_interaction_plot_configs <- function(df, type) {
         )
         plot_config$position <- "jitter"
 
+        # Cannot figure out how to place these properly for discrete x-axis so let's be hacky
         annotations <- list(
           list(x = 0.25, y = y_limits[1] + 0.1 * y_span, label = "                NG:"),
           list(x = 0.25, y = y_limits[1] + 0.05 * y_span, label = "                DB:"),
           list(x = 0.25, y = y_limits[1], label = "                SM:")
         )
 
-        # Loop over unique x values and add NG, DB, SM values at calculated y positions
         for (x_val in unique(df$conc_num_factor_factor)) {
           current_df <- df %>% filter(.data[[plot_config$x_var]] == x_val)
           annotations <- append(annotations, list(
@@ -941,9 +941,8 @@ generate_interaction_plot_configs <- function(df, type) {
 
       } else if (plot_type == "box") {
         plot_config$title <- sprintf("%s Boxplot RF for %s with SD", OrfRep, var)
-        plot_config$position <- "dodge"  # Boxplots don't need jitter, use dodge instead
+        plot_config$position <- "dodge"
 
-        # Append to boxplot configurations
         stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config))
       }
     }
@@ -982,20 +981,15 @@ generate_interaction_plot_configs <- function(df, type) {
       y_limits <- delta_limits_map[[var]]
       y_span <- y_limits[2] - y_limits[1]
 
-      # Error bars
       WT_sd_value <- first(group_data[[paste0("WT_sd_", var)]], default = 0)
-
-      # Z_Shift and lm values
       Z_Shift_value <- round(first(group_data[[paste0("Z_Shift_", var)]], default = 0), 2)
       Z_lm_value <- round(first(group_data[[paste0("Z_lm_", var)]], default = 0), 2)
       R_squared_value <- round(first(group_data[[paste0("R_Squared_", var)]], default = 0), 2)
 
-      # NG, DB, SM values
       NG_value <- first(group_data$NG, default = 0)
       DB_value <- first(group_data$DB, default = 0)
       SM_value <- first(group_data$SM, default = 0)
 
-      # Use the pre-calculated lm intercept and slope from the dataframe
       lm_intercept_col <- paste0("lm_intercept_", var)
       lm_slope_col <- paste0("lm_slope_", var)
       lm_intercept_value <- first(group_data[[lm_intercept_col]], default = 0)
@@ -1037,11 +1031,14 @@ generate_interaction_plot_configs <- function(df, type) {
     }
   }
 
-  # Return plot configs
-  return(list(
-    list(grid_layout = list(ncol = 2), plots = stats_plot_configs),
-    list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs),
-    list(grid_layout = list(ncol = 4), plots = delta_plot_configs[1:24])  # nrow calculated dynamically
+  # Group delta plots in chunks of 12
+  chunk_size <- 12
+  delta_plot_chunks <- split(delta_plot_configs, ceiling(seq_along(delta_plot_configs) / chunk_size))
+
+  return(c(
+    list(list(grid_layout = list(ncol = 2), plots = stats_plot_configs)),
+    list(list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs)),
+    lapply(delta_plot_chunks, function(chunk) list(grid_layout = list(ncol = 4), plots = chunk))
   ))
 }
 
@@ -1071,6 +1068,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
       df = df,
       x_var = rank_var,
       y_var = zscore_var,
+      x_label = "Rank",
       plot_type = "scatter",
       title = paste(y_label, "vs. Rank for", variable, "above", sd_band),
       sd_band = sd_band,
@@ -1090,13 +1088,13 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
       # Add specific annotations for plots with annotations
       plot_config$annotations <- list(
         list(
-          x = median(df[[rank_var]], na.rm = TRUE),
-          y = max(df[[zscore_var]], na.rm = TRUE) * 0.9,
+          x = nrow(df) / 2,
+          y = 10,
           label = paste("Deletion Enhancers =", num_enhancers)
         ),
         list(
-          x = median(df[[rank_var]], na.rm = TRUE),
-          y = min(df[[zscore_var]], na.rm = TRUE) * 0.9,
+          x = nrow(df) / 2,
+          y = -10,
           label = paste("Deletion Suppressors =", num_suppressors)
         )
       )
@@ -1124,7 +1122,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
   return(list(grid_layout = list(ncol = 3), plots = plot_configs))
 }
 
-generate_correlation_plot_configs <- function(df, correlation_stats) {
+generate_correlation_plot_configs <- function(df) {
   # Define relationships for different-variable correlations
   relationships <- list(
     list(x = "L", y = "K"),
@@ -1421,7 +1419,7 @@ main <- function() {
       list(out_dir = out_dir_qc, filename = "plate_analysis_boxplots",
         plot_configs = plate_analysis_boxplot_configs, page_width = 18, page_height = 9),
       list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros",
-        plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 12, page_height = 8),
+        plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 14, page_height = 9),
       list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros_boxplots",
         plot_configs = plate_analysis_no_zeros_boxplot_configs, page_width = 18, page_height = 9),
       list(out_dir = out_dir_qc, filename = "L_vs_K_for_strains_2SD_outside_mean_K",
@@ -1431,10 +1429,10 @@ main <- function() {
     )
 
     # Parallelize background and quality control plot generation
-    # furrr::future_map(plot_configs, function(config) {
-    #   generate_and_save_plots(config$out_dir, config$filename, config$plot_configs,
-    #     page_width = config$page_width, page_height = config$page_height)
-    # }, .options = furrr_options(seed = TRUE))
+    furrr::future_map(plot_configs, function(config) {
+      generate_and_save_plots(config$out_dir, config$filename, config$plot_configs,
+        page_width = config$page_width, page_height = config$page_height)
+    }, .options = furrr_options(seed = TRUE))
 
     # Loop over background strains
     # TODO currently only tested against one strain, if we want to do multiple strains we'll
@@ -1494,7 +1492,7 @@ main <- function() {
 
       message("Generating reference interaction plots")
       reference_plot_configs <- generate_interaction_plot_configs(df_interactions_reference_joined, "reference")
-      generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 18, page_height = 16)
+      generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 16, page_height = 16)
 
       message("Setting missing deletion values to the highest theoretical value at each drug conc for L")
       df_deletion <- df_na_stats %>% # formerly X2
@@ -1609,4 +1607,8 @@ main <- function() {
 main()
 
 # For future simplification of joined dataframes
-# df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats"))
+# df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats"))
+# # Add a custom horizontal line (for rank plots)
+# if (!is.null(config$hline) && config$hline) {
+#   plot <- plot + geom_hline(yintercept = config$hline, linetype = "dashed", color = "black")
+# }