Allow missing y_var for some plot types

This commit is contained in:
2024-09-10 23:04:24 -04:00
parent d8eb162fb5
commit 2eccb30b31

View File

@@ -336,58 +336,58 @@ 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) {
plots <- lapply(plot_configs, function(config) {
df <- config$df
# Helper function for plot type logic # Check if y_var is NULL and adjust the aes mapping
apply_plot_type <- function(plot, config) { aes_mapping <- if (is.null(config$y_var)) {
switch(config$plot_type, aes(x = !!sym(config$x_var), color = as.factor(!!sym(config$color_var)))
"rank" = { } else {
plot <- plot + geom_point(size = 0.1, shape = 3) aes(x = !!sym(config$x_var), y = !!sym(config$y_var), color = as.factor(!!sym(config$color_var)))
if (!is.null(config$sd_band)) { }
for (i in seq_len(config$sd_band)) {
plot <- plot + plot <- ggplot(df, aes_mapping)
annotate("rect", xmin = -Inf, xmax = Inf, ymin = i, ymax = Inf, fill = "#542788", alpha = 0.3) +
annotate("rect", xmin = -Inf, xmax = Inf, ymin = -i, ymax = -Inf, fill = "orange", alpha = 0.3) + # Handle plot types like "rank", "correlation", and default scatter/box/density
geom_hline(yintercept = c(-i, i), color = "gray") if (config$plot_type == "rank") {
} plot <- plot + geom_point(size = 0.1, shape = 3)
if (!is.null(config$sd_band)) {
for (i in seq_len(config$sd_band)) {
plot <- plot +
annotate("rect", xmin = -Inf, xmax = Inf, ymin = i, ymax = Inf, fill = "#542788", alpha = 0.3) +
annotate("rect", xmin = -Inf, xmax = Inf, ymin = -i, ymax = -Inf, fill = "orange", alpha = 0.3) +
geom_hline(yintercept = c(-i, i), color = "gray")
} }
plot }
}, if (!is.null(config$enhancer_label)) {
"correlation" = { plot <- plot + annotate("text", x = config$enhancer_label$x, y = config$enhancer_label$y,
plot + geom_point(shape = 3, color = "gray70") + geom_smooth(method = "lm", color = "tomato3") + label = config$enhancer_label$label) +
annotate("text", x = 0, y = 0, label = config$correlation_text) annotate("text", x = config$suppressor_label$x, y = config$suppressor_label$y, label = config$suppressor_label$label)
}, }
"box" = plot + geom_boxplot(), } else if (config$plot_type == "correlation") {
"density" = plot + geom_density(), plot <- plot + geom_point(shape = 3, color = "gray70") + geom_smooth(method = "lm", color = "tomato3") +
"bar" = plot + geom_bar(stat = "identity"), annotate("text", x = 0, y = 0, label = config$correlation_text)
plot + geom_point(shape = 3) + geom_smooth(method = "lm", se = FALSE) # Default scatter plot } else {
) # Adjust based on plot types that may or may not need y_var
} if (config$plot_type == "box") {
plot <- plot + geom_boxplot()
} else if (config$plot_type == "density") {
plot <- plot + geom_density()
} else if (config$plot_type == "bar") {
plot <- plot + geom_bar(stat = "identity")
} else {
plot <- plot + geom_point(shape = 3) + geom_smooth(method = "lm", se = FALSE)
}
}
# Helper function for error bars # Add error bars for "delta_bg" or general cases
apply_error_bars <- function(plot, config) {
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(ymin = !!sym(y_mean_col) - !!sym(y_sd_col), plot <- plot + geom_errorbar(aes(ymin = !!sym(y_mean_col) - !!sym(y_sd_col),
ymax = !!sym(y_mean_col) + !!sym(y_sd_col)), width = 0.1) + ymax = !!sym(y_mean_col) + !!sym(y_sd_col)), width = 0.1) +
geom_point(aes(y = !!sym(y_mean_col)), size = 0.6) geom_point(aes(y = !!sym(y_mean_col)), size = 0.6)
} }
plot
}
# Helper function for annotations
apply_annotations <- function(plot, config) {
if (!is.null(config$annotations)) {
plot <- plot + geom_text(aes(x = config$annotations$x, y = config$annotations$y, label = config$annotations$label))
}
plot
}
# Generate each plot
plots <- lapply(plot_configs, function(config) {
plot <- ggplot(config$df, aes(x = !!sym(config$x_var), y = !!sym(config$y_var), color = as.factor(!!sym(config$color_var))))
plot <- apply_plot_type(plot, config)
plot <- apply_error_bars(plot, config)
# Apply y-limits if provided # Apply y-limits if provided
if (!is.null(config$ylim_vals)) { if (!is.null(config$ylim_vals)) {
@@ -399,17 +399,19 @@ generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_la
theme_publication(legend_position = if (!is.null(config$legend_position)) config$legend_position else "bottom") + theme_publication(legend_position = if (!is.null(config$legend_position)) config$legend_position else "bottom") +
xlab(config$x_label %||% "") + ylab(config$y_label %||% "") xlab(config$x_label %||% "") + ylab(config$y_label %||% "")
plot <- apply_annotations(plot, config) # Add annotations if available
if (!is.null(config$annotations)) {
plot <- plot + geom_text(aes(x = config$annotations$x, y = config$annotations$y, label = config$annotations$label))
}
return(plot) return(plot)
}) })
# Save plots to PDF # Save the 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, print) lapply(plots, print)
dev.off() dev.off()
# Generate Plotly versions for interactive HTML
plotly_plots <- lapply(plots, function(plot) suppressWarnings(ggplotly(plot) %>% layout(legend = list(orientation = "h")))) plotly_plots <- lapply(plots, function(plot) suppressWarnings(ggplotly(plot) %>% layout(legend = list(orientation = "h"))))
# Handle grid layout # Handle grid layout
@@ -417,6 +419,7 @@ generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_la
saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE) saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE)
} }
generate_interaction_plot_configs <- function(df, variables) { generate_interaction_plot_configs <- function(df, variables) {
configs <- list() configs <- list()
@@ -661,11 +664,9 @@ main <- function() {
title = paste("Raw L vs K for strains above delta background threshold of", df_above_tolerance$delta_bg_tolerance[[1]], "or above"), title = paste("Raw L vs K for strains above delta background threshold of", df_above_tolerance$delta_bg_tolerance[[1]], "or above"),
color_var = "conc_num", color_var = "conc_num",
annotations = list( annotations = list(
list( x = L_half_median,
x = L_half_median, y = K_half_median,
y = K_half_median, label = paste("Strains above delta background tolerance =", nrow(df_above_tolerance))
label = paste("Strains above delta background tolerance =", nrow(df_above_tolerance))
)
), ),
error_bar = FALSE, error_bar = FALSE,
legend_position = "right" legend_position = "right"