瀏覽代碼

Fix interactive plotting for plotly

Bryan Roessler 8 月之前
父節點
當前提交
a439b0b909
共有 1 個文件被更改,包括 87 次插入35 次删除
  1. 87 35
      qhtcp-workflow/apps/r/calculate_interaction_zscores.R

+ 87 - 35
qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -381,16 +381,12 @@ calculate_interaction_scores <- function(df, max_conc, variables, group_vars = c
 }
 
 generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_layout = NULL) {
-
   message("Generating html and pdf plots for: ", file_name)
 
   plots <- lapply(plot_configs, function(config) {
     df <- config$df
 
-    # print(df %>% select(any_of(c("OrfRep", "Plate", "scan", "Col", "Row", "num", "OrfRep", "conc_num", "conc_num_factor",
-    #   "delta_bg_tolerance", "delta_bg", "Gene", "L", "K", "r", "AUC", "NG", "DB"))), n = 5)
-
-    # Plots are testy about missing aesthetics, so handle them here
+    # Build the aesthetic mapping
     aes_mapping <-
       if (is.null(config$color_var)) {
         if (is.null(config$y_var)) {
@@ -402,42 +398,67 @@ generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_la
         if (is.null(config$y_var)) {
           aes(x = !!sym(config$x_var), color = as.factor(!!sym(config$color_var)))
         } else {
-          aes(x = !!sym(config$x_var), y = !!sym(config$y_var), color = as.factor(!!sym(config$color_var)))
+          aes(
+            x = !!sym(config$x_var),
+            y = !!sym(config$y_var),
+            color = as.factor(!!sym(config$color_var))
+          )
         }
       }
 
     # Start building the plot
     plot <- ggplot(df, aes_mapping)
 
-    # Use appropriate helper function based on plot type
-    plot <- switch(config$plot_type,
-      "scatter" = generate_scatter_plot(plot, config),
+    # Generate non-interactive plot
+    static_plot <- switch(
+      config$plot_type,
+      "scatter" = generate_scatter_plot(plot, config, interactive = FALSE),
+      "box" = generate_box_plot(plot, config),
+      "density" = plot + geom_density(),
+      "bar" = plot + geom_bar(),
+      plot  # default case if no type matches
+    )
+
+    # Generate interactive plot
+    interactive_plot <- switch(
+      config$plot_type,
+      "scatter" = generate_scatter_plot(plot, config, interactive = TRUE),
       "box" = generate_box_plot(plot, config),
       "density" = plot + geom_density(),
       "bar" = plot + geom_bar(),
       plot  # default case if no type matches
     )
 
-    return(list(plot = plot, config = config))
+    return(list(static_plot = static_plot, interactive_plot = interactive_plot, config = config))
   })
 
-  # PDF saving logic
+  # PDF saving logic with static plots
   pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9)
-  lapply(plots, function(item) print(item$plot))
+  lapply(plots, function(item) print(item$static_plot))
   dev.off()
-  
-  # HTML saving logic
+
+  # HTML saving logic with interactive plots
   plotly_plots <- lapply(plots, function(item) {
-    plot <- item$plot
+    plot <- item$interactive_plot
     config <- item$config
     if (!is.null(config$legend_position) && config$legend_position == "bottom") {
-      suppressWarnings(ggplotly(plot, tooltip = "text") %>% layout(legend = list(orientation = "h")))
+      suppressWarnings(
+        ggplotly(plot, tooltip = "text") %>% layout(legend = list(orientation = "h"))
+      )
     } else {
       ggplotly(plot, tooltip = "text")
     }
   })
-  combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plots), margin = 0.05)
-  saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE)
+  combined_plot <- subplot(
+    plotly_plots,
+    nrows = grid_layout$nrow %||% length(plots),
+    margin = 0.05
+  )
+  saveWidget(
+    combined_plot,
+    file = file.path(output_dir, paste0(file_name, ".html")),
+    selfcontained = TRUE
+  )
 }
 
 generate_scatter_plot <- function(plot, config, interactive = FALSE) {
@@ -445,31 +466,58 @@ generate_scatter_plot <- function(plot, config, interactive = FALSE) {
   missing_data <- config$df %>%
     filter(
       is.na(!!sym(config$x_var)) | is.na(!!sym(config$y_var)) |
-      !!sym(config$y_var) < min(config$ylim_vals, na.rm = TRUE) |
-      !!sym(config$y_var) > max(config$ylim_vals, na.rm = TRUE)
+        !!sym(config$y_var) < min(config$ylim_vals, na.rm = TRUE) |
+        !!sym(config$y_var) > max(config$ylim_vals, na.rm = TRUE)
     )
 
   # Print the rows with missing or out-of-range data if any
   if (nrow(missing_data) > 0) {
     message("Missing or out-of-range data for ", config$title, ":")
-    print(missing_data %>% select(any_of(c("OrfRep", "Gene", "num", "conc_num", "conc_num_factor", config$x_var, config$y_var))), n = 100)
+    print(
+      missing_data %>% select(any_of(
+        c(
+          "OrfRep",
+          "Gene",
+          "num",
+          "conc_num",
+          "conc_num_factor",
+          config$x_var,
+          config$y_var
+        )
+      )),
+      n = 100
+    )
   }
 
   # Add the interactive `text` aesthetic if `interactive` is TRUE
   if (interactive) {
-    plot <- if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
-      plot + geom_point(aes(text = paste("ORF:", OrfRep, "Gene:", Gene, "delta_bg:", delta_bg)),
-        shape = config$shape %||% 3, size = config$size %||% 0.2)
+    if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
+      plot <- plot + geom_point(
+        aes(text = paste("ORF:", OrfRep, "Gene:", Gene, "delta_bg:", delta_bg)),
+        shape = config$shape %||% 3,
+        size = config$size %||% 0.2
+      )
     } else if (!is.null(config$gene_point) && config$gene_point) {
-      plot + geom_point(aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
-        shape = config$shape %||% 3, size = config$size %||% 0.2, position = "jitter")
+      plot <- plot + geom_point(
+        aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
+        shape = config$shape %||% 3,
+        size = config$size %||% 0.2,
+        position = "jitter"
+      )
     } else {
-      plot + geom_point(shape = config$shape %||% 3, size = config$size %||% 0.2)
+      plot <- plot + geom_point(
+        aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
+        shape = config$shape %||% 3,
+        size = config$size %||% 0.2
+      )
     }
   } else {
-    # For non-interactive plots, just add `geom_point`
-    plot <- plot + geom_point(shape = config$shape %||% 3, size = config$size %||% 0.2,
-      position = if (!is.null(config$position) && config$position == "jitter") "jitter" else "identity")
+    # For non-interactive plots, just add `geom_point` without `text` aesthetic
+    plot <- plot + geom_point(
+      shape = config$shape %||% 3,
+      size = config$size %||% 0.2,
+      position = if (!is.null(config$position) && config$position == "jitter") "jitter" else "identity"
+    )
   }
 
   # Add smooth line if specified
@@ -495,10 +543,13 @@ generate_scatter_plot <- function(plot, config, interactive = FALSE) {
   if (!is.null(config$error_bar) && config$error_bar) {
     y_mean_col <- paste0("mean_", config$y_var)
     y_sd_col <- paste0("sd_", config$y_var)
-    plot <- plot + geom_errorbar(aes(
-      ymin = !!sym(y_mean_col) - !!sym(y_sd_col),
-      ymax = !!sym(y_mean_col) + !!sym(y_sd_col)
-    ), alpha = 0.3)
+    plot <- plot + geom_errorbar(
+      aes(
+        ymin = !!sym(y_mean_col) - !!sym(y_sd_col),
+        ymax = !!sym(y_mean_col) + !!sym(y_sd_col)
+      ),
+      alpha = 0.3
+    )
   }
 
   # Add x-axis customization if specified
@@ -506,7 +557,8 @@ generate_scatter_plot <- function(plot, config, interactive = FALSE) {
     plot <- plot + scale_x_continuous(
       name = config$x_label,
       breaks = config$x_breaks,
-      labels = config$x_labels)
+      labels = config$x_labels
+    )
   }
 
   # Use coord_cartesian for zooming in without removing data outside the range