Move automatic nrow calculation to generate_and_save_plots

qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -513,20 +513,67 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
     static_plots <- list()
     plotly_plots <- list()
 
+    # Retrieve grid layout if it exists, otherwise skip
     grid_layout <- group$grid_layout
     plots <- group$plots
 
+    # Only handle grid layout if it exists
+    if (!is.null(grid_layout)) {
+      # Set grid_ncol to 1 if not specified
+      if (is.null(grid_layout$ncol)) {
+        grid_layout$ncol <- 1
+      }
+
+      # If ncol is set but nrow is not, calculate nrow dynamically based on num_plots
+      if (!is.null(grid_layout$ncol) && is.null(grid_layout$nrow)) {
+        num_plots <- length(plots)
+        nrow <- ceiling(num_plots / grid_layout$ncol)
+        message("No nrow provided, automatically using nrow = ", nrow)
+        grid_layout$nrow <- nrow
+      }
+    }
+
     for (i in seq_along(plots)) {
       config <- plots[[i]]
       df <- config$df
 
+      # Filter points outside of y-limits if specified
+      if (!is.null(config$ylim_vals)) {
+        out_of_bounds_df <- df %>%
+          filter(
+            is.na(.data[[config$y_var]]) |
+            .data[[config$y_var]] < config$ylim_vals[1] |
+            .data[[config$y_var]] > config$ylim_vals[2]
+          )
+        
+        # Print rows being filtered out
+        if (nrow(out_of_bounds_df) > 0) {
+          message("Filtered out rows outside y-limits:")
+          print(out_of_bounds_df)
+        }
+
+        # Filter the valid data for plotting
+        df <- df %>%
+          filter(
+            !is.na(.data[[config$y_var]]) &
+            .data[[config$y_var]] >= config$ylim_vals[1] &
+            .data[[config$y_var]] <= config$ylim_vals[2]
+          )
+      }
+
       # Set up aes mapping based on plot type
-      aes_mapping <- if (config$plot_type == "bar" || config$plot_type == "density") {
+      aes_mapping <- if (config$plot_type == "bar") {
         if (!is.null(config$color_var)) {
           aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
         } else {
           aes(x = .data[[config$x_var]])
         }
+      } else if (config$plot_type == "density") {
+        if (!is.null(config$color_var)) {
+          aes(x = .data[[config$x_var]], color = .data[[config$color_var]])
+        } else {
+          aes(x = .data[[config$x_var]])
+        }
       } else {
         if (!is.null(config$y_var) && !is.null(config$color_var)) {
           aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
@@ -573,63 +620,28 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
 
       # Add error bars if specified
       if (!is.null(config$error_bar) && config$error_bar) {
-        # Check if a fixed color is provided or if it should come from a data column
-        error_bar_color <- config$error_bar_params$color
-        
-        if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) {
-          # Check if ymin and ymax are constants or column names
-          if (is.numeric(config$error_bar_params$ymin) && is.numeric(config$error_bar_params$ymax)) {
-            plot <- plot + geom_errorbar(
-              aes(x = .data[[config$x_var]]),
-              ymin = config$error_bar_params$ymin,
-              ymax = config$error_bar_params$ymax
+        y_mean_col <- paste0("mean_", config$y_var)
+        y_sd_col <- paste0("sd_", config$y_var)
+        # If color_var is provided and no fixed error bar color is set, use aes() to map color dynamically
+        if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) {
+          plot <- plot + geom_errorbar(
+            aes(
+              x = .data[[config$x_var]],
+              ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
+              ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
+              color = .data[[config$color_var]]  # Dynamic color from the data
             )
-          } else {
-            # Map color_var to data if available
-            if (!is.null(config$color_var)) {
-              plot <- plot + geom_errorbar(
-                aes(
-                  x = .data[[config$x_var]],
-                  ymin = .data[[config$error_bar_params$ymin]],
-                  ymax = .data[[config$error_bar_params$ymax]],
-                  color = .data[[config$color_var]]
-                )
-              )
-            } else {
-              plot <- plot + geom_errorbar(
-                aes(
-                  x = .data[[config$x_var]],
-                  ymin = .data[[config$error_bar_params$ymin]],
-                  ymax = .data[[config$error_bar_params$ymax]]
-                )
-              )
-            }
-          }
+          )
         } else {
-          # Use mean and SD columns from df
-          y_mean_col <- paste0("mean_", config$y_var)
-          y_sd_col <- paste0("sd_", config$y_var)
-
-          if (y_mean_col %in% colnames(df) && y_sd_col %in% colnames(df)) {
-            if (!is.null(config$color_var)) {
-              plot <- plot + geom_errorbar(
-                aes(
-                  x = .data[[config$x_var]],
-                  ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
-                  ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
-                  color = .data[[config$color_var]]
-                )
-              )
-            } else {
-              plot <- plot + geom_errorbar(
-                aes(
-                  x = .data[[config$x_var]],
-                  ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
-                  ymax = .data[[y_mean_col]] + .data[[y_sd_col]]
-                )
-              )
-            }
-          }
+          # If a fixed error bar color is set, use it outside aes
+          plot <- plot + geom_errorbar(
+            aes(
+              x = .data[[config$x_var]],
+              ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
+              ymax = .data[[y_mean_col]] + .data[[y_sd_col]]
+            ),
+            color = config$error_bar_params$color  # Fixed color
+          )
         }
       }
 
@@ -869,6 +881,7 @@ generate_interaction_plot_configs <- function(df, type) {
       # Common plot configuration
       plot_config <- list(
         df = df,
+        plot_type = plot_type,
         x_var = "conc_num_factor_factor",
         y_var = var,
         shape = 16,
@@ -880,40 +893,35 @@ generate_interaction_plot_configs <- function(df, type) {
 
       # Add specific configurations for scatter and box plots
       if (plot_type == "scatter") {
-        plot_config$plot_type <- "scatter"
         plot_config$title <- sprintf("%s Scatter RF for %s with SD", OrfRep, var)
         plot_config$error_bar <- TRUE
         plot_config$error_bar_params <- list(
-          y_sd_prefix = "WT_sd_",
-          y_mean_prefix = "mean_",
           color = "red",
           center_point = TRUE
         )
         plot_config$position <- "jitter"
 
-      annotations <- list(
-        list(x = 0.25, y = y_limits[1] + 0.1 * y_span, label = "               NG ="), # Slightly above y-min
-        list(x = 0.25, y = y_limits[1] + 0.05 * y_span, label = "               DB ="),
-        list(x = 0.25, y = y_limits[1], label = "               SM =")
-      )
+        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(
-          list(x = x_val, y = y_limits[1] + 0.1 * y_span, label = first(current_df$NG, default = 0)),
-          list(x = x_val, y = y_limits[1] + 0.05 * y_span, label = first(current_df$DB, default = 0)),
-          list(x = x_val, y = y_limits[1], label = first(current_df$SM, default = 0))
-        ))
-      }
+        # 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(
+            list(x = x_val, y = y_limits[1] + 0.1 * y_span, label = first(current_df$NG, default = 0)),
+            list(x = x_val, y = y_limits[1] + 0.05 * y_span, label = first(current_df$DB, default = 0)),
+            list(x = x_val, y = y_limits[1], label = first(current_df$SM, default = 0))
+          ))
+        }
 
-      plot_config$annotations <- annotations
+        plot_config$annotations <- annotations
         
-        # Append to scatter plot configurations
         stats_plot_configs <- append(stats_plot_configs, list(plot_config))
 
       } else if (plot_type == "box") {
-        plot_config$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
 
@@ -1001,6 +1009,7 @@ generate_interaction_plot_configs <- function(df, type) {
         x_breaks = unique(group_data$conc_num_factor_factor),
         x_labels = as.character(unique(group_data$conc_num)),
         ylim_vals = y_limits,
+        y_filter = FALSE,
         lm_line = list(
           intercept = lm_intercept_value,
           slope = lm_slope_value
@@ -1010,15 +1019,10 @@ generate_interaction_plot_configs <- function(df, type) {
     }
   }
 
-  # Calculate dynamic grid layout
-  grid_ncol <- 4
-  num_plots <- length(delta_plot_configs)
-  grid_nrow <- ceiling(num_plots / grid_ncol)
-
   return(list(
-    list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_plot_configs),
-    list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_boxplot_configs),
-    list(grid_layout = list(ncol = 4, nrow = grid_nrow), plots = delta_plot_configs)
+    list(grid_layout = list(ncol = 2), plots = stats_plot_configs),  # nrow will be calculated dynamically
+    list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs),  # nrow will be calculated dynamically
+    list(grid_layout = list(ncol = 4), plots = delta_plot_configs)  # nrow will be calculated dynamically
   ))
 }
 
@@ -1412,9 +1416,9 @@ main <- function() {
         plot_configs = delta_bg_outside_2sd_k_plot_configs)
     )
 
-    furrr::future_map(plot_configs, function(config) {
-      generate_and_save_plots(config$out_dir, config$filename, config$plot_configs)
-    }, .options = furrr_options(seed = TRUE))
+    # furrr::future_map(plot_configs, function(config) {
+    #   generate_and_save_plots(config$out_dir, config$filename, config$plot_configs)
+    # }, .options = furrr_options(seed = TRUE))
 
     bg_strains <- c("YDL227C")
     lapply(bg_strains, function(strain) {