Make error bar expression configurable

qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -7,7 +7,6 @@ suppressMessages({
   library("rlang")
   library("ggthemes")
   library("data.table")
-  library("grid")
   library("gridExtra")
   library("future")
   library("furrr")
@@ -546,6 +545,15 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
         message("No nrow provided, automatically using nrow = ", nrow)
         grid_layout$nrow <- nrow
       }
+
+      # Fill missing spots with nullGrob() if necessary
+      total_spots <- grid_layout$nrow * grid_layout$ncol
+      num_plots <- length(plots)
+      
+      if (num_plots < total_spots) {
+        message("Filling ", total_spots - num_plots, " empty spots with nullGrob()")
+        plots <- c(plots, replicate(total_spots - num_plots, nullGrob(), simplify = FALSE))
+      }
     }
 
     for (i in seq_along(plots)) {
@@ -653,51 +661,56 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
           paste0("sd_", config$y_var)
         }
 
-        # If color_var is provided and no fixed error bar color is set, use aes() to map color dynamically
+        # Use rlang to handle custom error bar calculations
-        if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) {
+        if (!is.null(config$error_bar_params$custom_error_bar)) {
+          custom_ymin_expr <- rlang::parse_expr(config$error_bar_params$custom_error_bar$ymin)
+          custom_ymax_expr <- rlang::parse_expr(config$error_bar_params$custom_error_bar$ymax)
+
           plot <- plot + geom_errorbar(
             aes(
               x = .data[[config$x_var]],
-              ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
+              ymin = !!custom_ymin_expr,
-              ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
+              ymax = !!custom_ymax_expr
-              color = .data[[config$color_var]]
-            ),
-            linewidth = 0.1
-          )
-        } else {
-          # 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,
             linewidth = 0.1
           )
+          
+        } else {
+          # If no custom error bar formula, use the default or dynamic ones
+          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]]
+              ),
+              linewidth = 0.1
+            )
+          } 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]]
+              ),
+              color = config$error_bar_params$color,
+              linewidth = 0.1
+            )
+          }
         }
 
         # Add the center point if the option is provided
         if (!is.null(config$error_bar_params$mean_point) && config$error_bar_params$mean_point) {
-          if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) {
+          plot <- plot + geom_point(
-            plot <- plot + geom_point(
+            aes(
-              aes(
+              x = .data[[config$x_var]],
-                x = .data[[config$x_var]],
+              y = .data[[y_mean_col]]
-                y = .data[[y_mean_col]],
+            ),
-                color = .data[[config$color_var]]
+            color = config$error_bar_params$color,
-              ),
+            shape = 16
-              shape = 16
+          )
-            )
-          } else {
-            plot <- plot + geom_point(
-              aes(
-                x = .data[[config$x_var]],
-                y = .data[[y_mean_col]]
-              ),
-              color = config$error_bar_params$color,
-              shape = 16
-            )
-          }
         }
       }
 
@@ -722,7 +735,6 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
         ncol = grid_layout$ncol,
         nrow = grid_layout$nrow
       )
-      # grid.newpage()
     }
   }
 
@@ -1054,17 +1066,19 @@ generate_interaction_plot_configs <- function(df_summary, df_interaction, type)
         title_size = rel(1.3),
         coord_cartesian = y_limits,
         annotations = list(
-          list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste("ZShift =", Z_Shift_value)),
+          list(x = 1, y = y_limits[2] - 0.1 * y_span, label = paste("     ZShift =", round(Z_Shift_value, 2))),
-          list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste("lm ZScore =", Z_lm_value)),
+          list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste("           lm ZScore =", round(Z_lm_value, 2))),
-          list(x = 1, y = y_limits[2] - 0.4 * y_span, label = paste("R-squared =", R_squared_value)),
+          list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste("           R-squared =", round(R_squared_value, 2))),
-          list(x = 1, y = y_limits[1] + 0.2 * y_span, label = paste("NG =", NG_value)),
+          list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("NG =", NG_value)),
-          list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("DB =", DB_value)),
+          list(x = 1, y = y_limits[1] + 0.05 * y_span, label = paste("DB =", DB_value)),
           list(x = 1, y = y_limits[1], label = paste("SM =", SM_value))
         ),
         error_bar = TRUE,
         error_bar_params = list(
-          ymin = 0 - (2 * WT_sd_value),
+          custom_error_bar = list(
-          ymax = 0 + (2 * WT_sd_value),
+            ymin = paste0("0 - 2 * WT_sd_", var),
+            ymax = paste0("0 + 2 * WT_sd_", var)
+          ),
           color = "gray"
         ),
         x_breaks = unique(group_data$conc_num_factor_factor),
@@ -1680,10 +1694,3 @@ main <- function() {
   })
 }
 main()
-
-# For future simplification of joined dataframes
-# 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")
-# }