Refactor plot generation to support interactive plotly plots
This commit is contained in:
@@ -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 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
|
||||
plot <- ggplot(df, aes_mapping)
|
||||
# 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 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 the plot
|
||||
plot
|
||||
}
|
||||
|
||||
# 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
|
||||
)
|
||||
# Generate the static plot
|
||||
static_plot <- generate_plot(interactive = FALSE)
|
||||
|
||||
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)
|
||||
lapply(plots, function(item) print(item$static_plot))
|
||||
lapply(static_plots, print)
|
||||
dev.off()
|
||||
|
||||
# HTML saving logic with interactive plots
|
||||
plotly_plots <- lapply(plots, function(item) {
|
||||
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"))
|
||||
)
|
||||
} 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
|
||||
)
|
||||
# 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)
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user