From a439b0b9098dc733599be625b84fe57fc9c8b7d1 Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Sun, 15 Sep 2024 10:51:09 -0400 Subject: [PATCH] Fix interactive plotting for plotly --- .../apps/r/calculate_interaction_zscores.R | 122 +++++++++++++----- 1 file changed, 87 insertions(+), 35 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 5e655397..2b58cb00 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/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 ) - return(list(plot = plot, config = config)) + # 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(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