Append plots to same file instead of overwriting

qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -294,12 +294,16 @@ calculate_interaction_scores <- function(df, max_conc, bg_stats, group_vars, ove
   lm_means_sds <- calculations %>%
     group_by(across(all_of(group_vars))) %>%
     summarise(
+      mean_mean_L = mean(mean_L, na.rm = TRUE),
       mean_lm_L = mean(lm_Score_L, na.rm = TRUE),
       sd_lm_L = sd(lm_Score_L, na.rm = TRUE),
+      mean_mean_K = mean(mean_K, na.rm = TRUE),
       mean_lm_K = mean(lm_Score_K, na.rm = TRUE),
       sd_lm_K = sd(lm_Score_K, na.rm = TRUE),
+      mean_mean_r = mean(mean_r, na.rm = TRUE),
       mean_lm_r = mean(lm_Score_r, na.rm = TRUE),
       sd_lm_r = sd(lm_Score_r, na.rm = TRUE),
+      mean_mean_AUC = mean(mean_AUC, na.rm = TRUE),
       mean_lm_AUC = mean(lm_Score_AUC, na.rm = TRUE),
       sd_lm_AUC = sd(lm_Score_AUC, na.rm = TRUE)
     )
@@ -408,8 +412,10 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
     plot_configs  # Multiple groups
   }
 
-  for (group in plot_groups) {
+  # Open the PDF device once for all plots
+  pdf(file.path(out_dir, paste0(filename, ".pdf")), width = 16, height = 9)
 
+  for (group in plot_groups) {
     static_plots <- list()
     plotly_plots <- list()
 
@@ -420,31 +426,26 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
       config <- plots[[i]]
       df <- config$df
 
-      if (config$plot_type == "bar") {
-        if (!is.null(config$color_var)) {
-          aes_mapping <- aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
-        } else {
-          aes_mapping <- aes(x = .data[[config$x_var]])
-        }
-      } else if (config$plot_type == "density") {
+      # Set up aes mapping based on plot type
+      aes_mapping <- if (config$plot_type == "bar" || config$plot_type == "density") {
         if (!is.null(config$color_var)) {
-          aes_mapping <- aes(x = .data[[config$x_var]], color = .data[[config$color_var]])
+          aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
         } else {
-          aes_mapping <- aes(x = .data[[config$x_var]])
+          aes(x = .data[[config$x_var]])
         }
       } else {
-        # For scatter and other plot types
         if (!is.null(config$y_var) && !is.null(config$color_var)) {
-          aes_mapping <- aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
+          aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
         } else if (!is.null(config$y_var)) {
-          aes_mapping <- aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
+          aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
         } else {
-          aes_mapping <- aes(x = .data[[config$x_var]])
+          aes(x = .data[[config$x_var]])
         }
       }
 
       plot <- ggplot(df, aes_mapping) + theme_publication(legend_position = config$legend_position)
 
+      # Add appropriate plot layer based on plot type
       plot <- switch(config$plot_type,
         "scatter" = generate_scatter_plot(plot, config),
         "box" = generate_boxplot(plot, config),
@@ -453,6 +454,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
         plot  # default (unused)
       )
 
+      # Add labels and title
       if (!is.null(config$title)) plot <- plot + ggtitle(config$title)
       if (!is.null(config$x_label)) plot <- plot + xlab(config$x_label)
       if (!is.null(config$y_label)) plot <- plot + ylab(config$y_label)
@@ -460,56 +462,66 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
 
       # Add error bars if specified
       if (!is.null(config$error_bar) && config$error_bar) {
-        error_bar_color <- if (!is.null(config$error_bar_params$color)) {
-          config$error_bar_params$color
-        } else {
-          "red"
+        error_bar_color <- config$error_bar_params$color %||% "red"
+        y_mean_col <- paste0("mean_", config$y_var)
+        y_sd_col <- paste0("sd_", config$y_var)
+
+        if (!is.null(config$error_bar_params$center_point)) {
+          plot <- plot + geom_point(aes(
+            x = .data[[config$x_var]],
+            y = .data[[y_mean_col]]),
+            color = error_bar_color,
+            shape = 16)
         }
 
         # Use error_bar_params if provided, otherwise calculate from mean and sd
         if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) {
           plot <- plot + geom_errorbar(aes(
             ymin = config$error_bar_params$ymin,
-            ymax = config$error_bar_params$ymax,
-            color = error_bar_color))
+            ymax = config$error_bar_params$ymax),
+            color = error_bar_color)
         } else {
-          y_mean_col <- paste0("mean_", config$y_var)
-          y_sd_col <- paste0("sd_", config$y_var)
           plot <- plot + geom_errorbar(aes(
             ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
-            ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
-            color = error_bar_color))
+            ymax = .data[[y_mean_col]] + .data[[y_sd_col]]),
+            color = error_bar_color)
         }
       }
 
+      # Convert ggplot to plotly for interactive version
       plotly_plot <- suppressWarnings(plotly::ggplotly(plot))
+
+      # Store both static and interactive versions
       static_plots[[i]] <- plot
       plotly_plots[[i]] <- plotly_plot
     }
 
-    pdf(file.path(out_dir, paste0(filename, ".pdf")), width = 16, height = 9)
-
+    # Print the plots to the PDF (one page per plot or in a grid)
     if (is.null(grid_layout)) {
+      # Print each plot individually on separate pages if no grid layout is specified
       for (plot in static_plots) {
         print(plot)
       }
     } else {
+      # Arrange plots in grid layout on a single page
       grid.arrange(
         grobs = static_plots,
         ncol = grid_layout$ncol,
         nrow = grid_layout$nrow
       )
     }
+  }
 
-    dev.off()
+  # Close the PDF device after all plots are done
+  dev.off()
 
-    # out_html_file <- file.path(out_dir, paste0(filename, ".html"))
-    # message("Saving combined HTML file: ", out_html_file)
-    # htmltools::save_html(
-    #   htmltools::tagList(plotly_plots),
-    #   file = out_html_file
-    # )
-  }
+  # Optional: Uncomment and save the interactive HTML version if needed
+  # out_html_file <- file.path(out_dir, paste0(filename, ".html"))
+  # message("Saving combined HTML file: ", out_html_file)
+  # htmltools::save_html(
+  #   htmltools::tagList(plotly_plots),
+  #   file = out_html_file
+  # )
 }
 
 generate_scatter_plot <- function(plot, config) {
@@ -519,7 +531,7 @@ generate_scatter_plot <- function(plot, config) {
   size <- if (!is.null(config$size)) config$size else 1.5
   position <-
     if (!is.null(config$position) && config$position == "jitter") {
-      position_jitter(width = 0.2, height = 0)
+      position_jitter(width = 0.3, height = 0.1)
     } else {
       "identity"
     }
@@ -727,47 +739,66 @@ generate_interaction_plot_configs <- function(df, type) {
     r = c(-0.6, 0.6),
     AUC = c(-6000, 6000)
   )
-
-  overall_plot_configs <- list()
+  
+  stats_plot_configs <- list()
+  stats_boxplot_configs <- list()
   delta_plot_configs <- list()
 
   # Overall statistics plots
   OrfRep <- first(df$OrfRep) # this should correspond to the reference strain
 
-  for (var in names(limits_map)) {
-    y_limits <- limits_map[[var]]
+  for (plot_type in c("scatter", "box")) {
 
-    # 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)
+    for (var in names(limits_map)) {
+      y_limits <- limits_map[[var]]
 
-    # Ensure no NA or invalid values in lm_line calculations
-    intercept_value <- mean(df[[lm_intercept_col]], na.rm = TRUE)
-    slope_value <- mean(df[[lm_slope_col]], na.rm = TRUE)
+      # 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)
 
-    plot_config <- list(
-      df = df,
-      plot_type = "scatter",
-      x_var = "conc_num_factor_factor",
-      y_var = var,
-      shape = 16,
-      x_label = unique(df$Drug)[1],
-      title = sprintf("%s Scatter RF for %s with SD", OrfRep, var),
-      coord_cartesian = y_limits,
-      error_bar = TRUE,
-      error_bar_params = list(
-        color = "red"
-      ),
-      x_breaks = unique(df$conc_num_factor_factor),
-      x_labels = as.character(unique(df$conc_num)),
-      position = "jitter",
-      smooth = TRUE,
-      lm_line = list(
-        intercept = intercept_value,
-        slope = slope_value
+      # Ensure no NA or invalid values in lm_line calculations
+      intercept_value <- mean(df[[lm_intercept_col]], na.rm = TRUE)
+      slope_value <- mean(df[[lm_slope_col]], na.rm = TRUE)
+
+      # Common plot configuration
+      plot_config <- list(
+        df = df,
+        x_var = "conc_num_factor_factor",
+        y_var = var,
+        shape = 16,
+        x_label = unique(df$Drug)[1],
+        coord_cartesian = y_limits,
+        x_breaks = unique(df$conc_num_factor_factor),
+        x_labels = as.character(unique(df$conc_num)),
+        lm_line = list(
+          intercept = intercept_value,
+          slope = slope_value
+        )
       )
-    )
-    overall_plot_configs <- append(overall_plot_configs, list(plot_config))
+
+      # 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(
+          color = "red",
+          center_point = TRUE
+        )
+        plot_config$position <- "jitter"
+        
+        # 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
+
+        # Append to boxplot configurations
+        stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config))
+      }
+    }
   }
 
   # Delta interaction plots
@@ -850,7 +881,8 @@ generate_interaction_plot_configs <- function(df, type) {
   grid_nrow <- ceiling(num_plots / grid_ncol)
 
   return(list(
-    list(grid_layout = list(ncol = 2, nrow = 2), plots = overall_plot_configs),
+    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)
   ))
 }