Selaa lähdekoodia

Use tooltips rather than text aes for interactive plotly

Bryan Roessler 8 kuukautta sitten
vanhempi
commit
ee986fbd60
1 muutettua tiedostoa jossa 52 lisäystä ja 61 poistoa
  1. 52 61
      qhtcp-workflow/apps/r/calculate_interaction_zscores.R

+ 52 - 61
qhtcp-workflow/apps/r/calculate_interaction_zscores.R

@@ -393,65 +393,69 @@ generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_la
     # 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, is_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
-      )
-
-      # Apply additional settings if provided
-      if (!is.null(config$legend_position)) {
-        plot <- plot + theme(legend.position = config$legend_position)
-      }
-
-      # 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)
-      }
+    # Use appropriate helper function based on plot type
+    plot <- switch(config$plot_type,
+      "scatter" = generate_scatter_plot(plot_base, config),
+      "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
+    )
 
-      # Return the plot
-      plot
+    # Apply additional settings if provided
+    if (!is.null(config$legend_position)) {
+      plot <- plot + theme(legend.position = config$legend_position)
     }
 
-    # Generate the static plot
-    static_plot <- generate_plot(interactive = FALSE)
+    # 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)
+    }
 
-    # Generate the interactive plot
-    interactive_plot <- generate_plot(interactive = TRUE)
+    # Add interactive tooltips for plotly plots
+    tooltip_vars <- c("x", "y")  # default tooltip variables
+    if (!is.null(config$tooltip_vars)) {
+      tooltip_vars <- config$tooltip_vars
+    } else {
+      # Include default variables based on config
+      if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
+        tooltip_vars <- c(tooltip_vars, "OrfRep", "Gene", "delta_bg")
+      } else if (!is.null(config$gene_point) && config$gene_point) {
+        tooltip_vars <- c(tooltip_vars, "OrfRep", "Gene")
+      } else {
+        # Include x and y variables by default
+        tooltip_vars <- c("x", "y")
+      }
+    }
 
     # Convert to plotly object
-    plotly_plot <- ggplotly(interactive_plot, tooltip = "text")
+    plotly_plot <- ggplotly(plot, tooltip = tooltip_vars)
     if (!is.null(config$legend_position) && config$legend_position == "bottom") {
       plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h"))
     }
 
     # Add plots to lists
-    static_plots[[i]] <- static_plot
+    static_plots[[i]] <- plot
     plotly_plots[[i]] <- plotly_plot
   }
 
-  # PDF saving logic
+  # Save static PDF plots
   pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9)
   lapply(static_plots, print)
   dev.off()
 
-  # Combine and save interactive plots
+  # Combine and save interactive HTML 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, is_interactive = FALSE) {
+generate_scatter_plot <- function(plot, config) {
   # Check for missing or out-of-range data
   missing_data <- config$df %>%
     filter(
@@ -479,33 +483,20 @@ generate_scatter_plot <- function(plot, config, is_interactive = FALSE) {
     )
   }
 
-  # Add the interactive text aesthetic if `is_interactive` is TRUE
-  if (is_interactive) {
-    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 <- plot + geom_point(
-        aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
-        shape = config$shape %||% 3,
-        size = config$size %||% 0.2,
-        position = "jitter"
-      )
-    } else {
-      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` without `text` aesthetic
+  if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
+    plot <- plot + geom_point(
+      shape = config$shape %||% 3,
+      size = config$size %||% 0.2
+    )
+  } else if (!is.null(config$gene_point) && config$gene_point) {
     plot <- plot + geom_point(
       shape = config$shape %||% 3,
       size = config$size %||% 0.2,
+      position = "jitter"
+    )
+  } else {
+    plot <- plot + geom_point(
+      shape = config$shape %||% 3,
       position = if (!is.null(config$position) && config$position == "jitter") "jitter" else "identity"
     )
   }