Refactor plot generation to support interactive plotly plots

This commit is contained in:
2024-09-15 11:44:16 -04:00
parent 4877c1413e
commit 915885e2bf

View File

@@ -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) { 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) { # 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 df <- config$df
# Build the aesthetic mapping # Build the aes_mapping based on config
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)) { aes(x = .data[[config$x_var]])
aes(x = !!sym(config$x_var))
} else {
aes(x = !!sym(config$x_var), y = !!sym(config$y_var))
}
} else { } else {
if (is.null(config$y_var)) { aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
aes(x = !!sym(config$x_var), color = as.factor(!!sym(config$color_var))) }
} else { } else {
aes( if (is.null(config$y_var)) {
x = !!sym(config$x_var), aes(x = .data[[config$x_var]], color = as.factor(.data[[config$color_var]]))
y = !!sym(config$y_var), } else {
color = as.factor(!!sym(config$color_var)) aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = as.factor(.data[[config$color_var]]))
) }
} }
# 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
)
# Apply additional settings if provided
if (!is.null(config$legend_position)) {
plot <- plot + theme(legend.position = config$legend_position)
} }
# Start building the plot # Add title and labels if provided
plot <- ggplot(df, aes_mapping) 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 non-interactive plot # Return the plot
static_plot <- switch( plot
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 # Generate the static plot
interactive_plot <- switch( static_plot <- generate_plot(interactive = FALSE)
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)) # Generate the interactive plot
}) interactive_plot <- generate_plot(interactive = TRUE)
# PDF saving logic with static plots # Convert to plotly object
plotly_plot <- ggplotly(interactive_plot, tooltip = "text")
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
plotly_plots[[i]] <- plotly_plot
}
# PDF saving logic
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$static_plot)) lapply(static_plots, print)
dev.off() dev.off()
# HTML saving logic with interactive plots # Combine and save interactive plots
plotly_plots <- lapply(plots, function(item) { combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plotly_plots), margin = 0.05)
plot <- item$interactive_plot saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE)
config <- item$config
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")
}
})
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) { generate_scatter_plot <- function(plot, config, interactive = FALSE) {
# Check for missing or out-of-range data # Check for missing or out-of-range data
missing_data <- config$df %>% 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) return(plot)
} }