Refactor plot generation to support interactive plotly plots

Tento commit je obsažen v:
2024-09-15 11:44:16 -04:00
rodič 4877c1413e
revize 915885e2bf

Zobrazit soubor

@@ -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)
}