Fix interactive plotting for plotly

This commit is contained in:
2024-09-15 10:51:09 -04:00
parent d79f6a4f2c
commit a439b0b909

View File

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