فهرست منبع

Refactor plot generation to support interactive plotly plots

Bryan Roessler 7 ماه پیش
والد
کامیت
915885e2bf
1فایلهای تغییر یافته به همراه81 افزوده شده و 65 حذف شده
  1. 81 65
      qhtcp-workflow/apps/r/calculate_interaction_zscores.R

+ 81 - 65
qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -384,84 +384,91 @@ 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) {
+  # Prepare lists to collect plots
+  static_plots <- list()
+  plotly_plots <- list()
+
+  for (i in seq_along(plot_configs)) {
+    config <- plot_configs[[i]]
     df <- config$df
 
-    # Build the aesthetic mapping
-    aes_mapping <-
-      if (is.null(config$color_var)) {
-        if (is.null(config$y_var)) {
-          aes(x = !!sym(config$x_var))
-        } else {
-          aes(x = !!sym(config$x_var), y = !!sym(config$y_var))
-        }
+    # Build the aes_mapping based on config
+    aes_mapping <- if (is.null(config$color_var)) {
+      if (is.null(config$y_var)) {
+        aes(x = .data[[config$x_var]])
       } else {
-        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 = .data[[config$x_var]], y = .data[[config$y_var]])
       }
+    } else {
+      if (is.null(config$y_var)) {
+        aes(x = .data[[config$x_var]], color = as.factor(.data[[config$color_var]]))
+      } else {
+        aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = as.factor(.data[[config$color_var]]))
+      }
+    }
 
-    # Start building the plot
-    plot <- ggplot(df, aes_mapping)
-
-    # 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
-    )
+    # Start building the plot with aes_mapping
+    plot_base <- ggplot(df, aes_mapping)
+
+    # Function to generate the plot
+    generate_plot <- function(interactive) {
+      # Use appropriate helper function based on plot type
+      plot <- switch(config$plot_type,
+        "scatter" = generate_scatter_plot(plot_base, config, interactive = interactive),
+        "box" = generate_box_plot(plot_base, config),
+        "density" = plot_base + geom_density(),
+        "bar" = plot_base + geom_bar(),
+        plot_base  # 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
-    )
+      # Apply additional settings if provided
+      if (!is.null(config$legend_position)) {
+        plot <- plot + theme(legend.position = config$legend_position)
+      }
 
-    return(list(static_plot = static_plot, interactive_plot = interactive_plot, config = config))
-  })
+      # Add title and labels if provided
+      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)
+      }
 
-  # 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$static_plot))
-  dev.off()
+      # Return the plot
+      plot
+    }
+
+    # Generate the static plot
+    static_plot <- generate_plot(interactive = FALSE)
+
+    # Generate the interactive plot
+    interactive_plot <- generate_plot(interactive = TRUE)
 
-  # HTML saving logic with interactive plots
-  plotly_plots <- lapply(plots, function(item) {
-    plot <- item$interactive_plot
-    config <- item$config
+    # Convert to plotly object
+    plotly_plot <- ggplotly(interactive_plot, tooltip = "text")
     if (!is.null(config$legend_position) && config$legend_position == "bottom") {
-      suppressWarnings(
-        ggplotly(plot, tooltip = "text") %>% layout(legend = list(orientation = "h"))
-      )
-    } else {
-      ggplotly(plot, tooltip = "text")
+      plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h"))
     }
-  })
-  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
-  )
+
+    # Add plots to lists
+    static_plots[[i]] <- static_plot
+    plotly_plots[[i]] <- plotly_plot
+  }
+
+  # PDF saving logic
+  pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9)
+  lapply(static_plots, print)
+  dev.off()
+
+  # Combine and save interactive plots
+  combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plotly_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) {
   # Check for missing or out-of-range data
   missing_data <- config$df %>%
@@ -579,6 +586,15 @@ generate_scatter_plot <- function(plot, config, interactive = FALSE) {
     }
   }
 
+  # Add titles and themes if specified
+  if (!is.null(config$title)) {
+    plot <- plot + ggtitle(config$title)
+  }
+
+  if (!is.null(config$legend_position)) {
+    plot <- plot + theme(legend.position = config$legend_position)
+  }
+
   return(plot)
 }