Append plots to same file instead of overwriting
This commit is contained in:
@@ -294,12 +294,16 @@ calculate_interaction_scores <- function(df, max_conc, bg_stats, group_vars, ove
|
|||||||
lm_means_sds <- calculations %>%
|
lm_means_sds <- calculations %>%
|
||||||
group_by(across(all_of(group_vars))) %>%
|
group_by(across(all_of(group_vars))) %>%
|
||||||
summarise(
|
summarise(
|
||||||
|
mean_mean_L = mean(mean_L, na.rm = TRUE),
|
||||||
mean_lm_L = mean(lm_Score_L, na.rm = TRUE),
|
mean_lm_L = mean(lm_Score_L, na.rm = TRUE),
|
||||||
sd_lm_L = sd(lm_Score_L, na.rm = TRUE),
|
sd_lm_L = sd(lm_Score_L, na.rm = TRUE),
|
||||||
|
mean_mean_K = mean(mean_K, na.rm = TRUE),
|
||||||
mean_lm_K = mean(lm_Score_K, na.rm = TRUE),
|
mean_lm_K = mean(lm_Score_K, na.rm = TRUE),
|
||||||
sd_lm_K = sd(lm_Score_K, na.rm = TRUE),
|
sd_lm_K = sd(lm_Score_K, na.rm = TRUE),
|
||||||
|
mean_mean_r = mean(mean_r, na.rm = TRUE),
|
||||||
mean_lm_r = mean(lm_Score_r, na.rm = TRUE),
|
mean_lm_r = mean(lm_Score_r, na.rm = TRUE),
|
||||||
sd_lm_r = sd(lm_Score_r, na.rm = TRUE),
|
sd_lm_r = sd(lm_Score_r, na.rm = TRUE),
|
||||||
|
mean_mean_AUC = mean(mean_AUC, na.rm = TRUE),
|
||||||
mean_lm_AUC = mean(lm_Score_AUC, na.rm = TRUE),
|
mean_lm_AUC = mean(lm_Score_AUC, na.rm = TRUE),
|
||||||
sd_lm_AUC = sd(lm_Score_AUC, na.rm = TRUE)
|
sd_lm_AUC = sd(lm_Score_AUC, na.rm = TRUE)
|
||||||
)
|
)
|
||||||
@@ -408,8 +412,10 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
|
|||||||
plot_configs # Multiple groups
|
plot_configs # Multiple groups
|
||||||
}
|
}
|
||||||
|
|
||||||
for (group in plot_groups) {
|
# Open the PDF device once for all plots
|
||||||
|
pdf(file.path(out_dir, paste0(filename, ".pdf")), width = 16, height = 9)
|
||||||
|
|
||||||
|
for (group in plot_groups) {
|
||||||
static_plots <- list()
|
static_plots <- list()
|
||||||
plotly_plots <- list()
|
plotly_plots <- list()
|
||||||
|
|
||||||
@@ -420,31 +426,26 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
|
|||||||
config <- plots[[i]]
|
config <- plots[[i]]
|
||||||
df <- config$df
|
df <- config$df
|
||||||
|
|
||||||
if (config$plot_type == "bar") {
|
# Set up aes mapping based on plot type
|
||||||
|
aes_mapping <- if (config$plot_type == "bar" || config$plot_type == "density") {
|
||||||
if (!is.null(config$color_var)) {
|
if (!is.null(config$color_var)) {
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
|
aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
|
||||||
} else {
|
} else {
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]])
|
aes(x = .data[[config$x_var]])
|
||||||
}
|
|
||||||
} else if (config$plot_type == "density") {
|
|
||||||
if (!is.null(config$color_var)) {
|
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]], color = .data[[config$color_var]])
|
|
||||||
} else {
|
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]])
|
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
# For scatter and other plot types
|
|
||||||
if (!is.null(config$y_var) && !is.null(config$color_var)) {
|
if (!is.null(config$y_var) && !is.null(config$color_var)) {
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
|
aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
|
||||||
} else if (!is.null(config$y_var)) {
|
} else if (!is.null(config$y_var)) {
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
|
aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
|
||||||
} else {
|
} else {
|
||||||
aes_mapping <- aes(x = .data[[config$x_var]])
|
aes(x = .data[[config$x_var]])
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
plot <- ggplot(df, aes_mapping) + theme_publication(legend_position = config$legend_position)
|
plot <- ggplot(df, aes_mapping) + theme_publication(legend_position = config$legend_position)
|
||||||
|
|
||||||
|
# Add appropriate plot layer based on plot type
|
||||||
plot <- switch(config$plot_type,
|
plot <- switch(config$plot_type,
|
||||||
"scatter" = generate_scatter_plot(plot, config),
|
"scatter" = generate_scatter_plot(plot, config),
|
||||||
"box" = generate_boxplot(plot, config),
|
"box" = generate_boxplot(plot, config),
|
||||||
@@ -453,6 +454,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
|
|||||||
plot # default (unused)
|
plot # default (unused)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
# Add labels and title
|
||||||
if (!is.null(config$title)) plot <- plot + ggtitle(config$title)
|
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$x_label)) plot <- plot + xlab(config$x_label)
|
||||||
if (!is.null(config$y_label)) plot <- plot + ylab(config$y_label)
|
if (!is.null(config$y_label)) plot <- plot + ylab(config$y_label)
|
||||||
@@ -460,56 +462,66 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
|
|||||||
|
|
||||||
# Add error bars if specified
|
# Add error bars if specified
|
||||||
if (!is.null(config$error_bar) && config$error_bar) {
|
if (!is.null(config$error_bar) && config$error_bar) {
|
||||||
error_bar_color <- if (!is.null(config$error_bar_params$color)) {
|
error_bar_color <- config$error_bar_params$color %||% "red"
|
||||||
config$error_bar_params$color
|
y_mean_col <- paste0("mean_", config$y_var)
|
||||||
} else {
|
y_sd_col <- paste0("sd_", config$y_var)
|
||||||
"red"
|
|
||||||
|
if (!is.null(config$error_bar_params$center_point)) {
|
||||||
|
plot <- plot + geom_point(aes(
|
||||||
|
x = .data[[config$x_var]],
|
||||||
|
y = .data[[y_mean_col]]),
|
||||||
|
color = error_bar_color,
|
||||||
|
shape = 16)
|
||||||
}
|
}
|
||||||
|
|
||||||
# Use error_bar_params if provided, otherwise calculate from mean and sd
|
# Use error_bar_params if provided, otherwise calculate from mean and sd
|
||||||
if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) {
|
if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) {
|
||||||
plot <- plot + geom_errorbar(aes(
|
plot <- plot + geom_errorbar(aes(
|
||||||
ymin = config$error_bar_params$ymin,
|
ymin = config$error_bar_params$ymin,
|
||||||
ymax = config$error_bar_params$ymax,
|
ymax = config$error_bar_params$ymax),
|
||||||
color = error_bar_color))
|
color = error_bar_color)
|
||||||
} else {
|
} else {
|
||||||
y_mean_col <- paste0("mean_", config$y_var)
|
|
||||||
y_sd_col <- paste0("sd_", config$y_var)
|
|
||||||
plot <- plot + geom_errorbar(aes(
|
plot <- plot + geom_errorbar(aes(
|
||||||
ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
|
ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
|
||||||
ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
|
ymax = .data[[y_mean_col]] + .data[[y_sd_col]]),
|
||||||
color = error_bar_color))
|
color = error_bar_color)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Convert ggplot to plotly for interactive version
|
||||||
plotly_plot <- suppressWarnings(plotly::ggplotly(plot))
|
plotly_plot <- suppressWarnings(plotly::ggplotly(plot))
|
||||||
|
|
||||||
|
# Store both static and interactive versions
|
||||||
static_plots[[i]] <- plot
|
static_plots[[i]] <- plot
|
||||||
plotly_plots[[i]] <- plotly_plot
|
plotly_plots[[i]] <- plotly_plot
|
||||||
}
|
}
|
||||||
|
|
||||||
pdf(file.path(out_dir, paste0(filename, ".pdf")), width = 16, height = 9)
|
# Print the plots to the PDF (one page per plot or in a grid)
|
||||||
|
|
||||||
if (is.null(grid_layout)) {
|
if (is.null(grid_layout)) {
|
||||||
|
# Print each plot individually on separate pages if no grid layout is specified
|
||||||
for (plot in static_plots) {
|
for (plot in static_plots) {
|
||||||
print(plot)
|
print(plot)
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
# Arrange plots in grid layout on a single page
|
||||||
grid.arrange(
|
grid.arrange(
|
||||||
grobs = static_plots,
|
grobs = static_plots,
|
||||||
ncol = grid_layout$ncol,
|
ncol = grid_layout$ncol,
|
||||||
nrow = grid_layout$nrow
|
nrow = grid_layout$nrow
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Close the PDF device after all plots are done
|
||||||
dev.off()
|
dev.off()
|
||||||
|
|
||||||
|
# Optional: Uncomment and save the interactive HTML version if needed
|
||||||
# out_html_file <- file.path(out_dir, paste0(filename, ".html"))
|
# out_html_file <- file.path(out_dir, paste0(filename, ".html"))
|
||||||
# message("Saving combined HTML file: ", out_html_file)
|
# message("Saving combined HTML file: ", out_html_file)
|
||||||
# htmltools::save_html(
|
# htmltools::save_html(
|
||||||
# htmltools::tagList(plotly_plots),
|
# htmltools::tagList(plotly_plots),
|
||||||
# file = out_html_file
|
# file = out_html_file
|
||||||
# )
|
# )
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
generate_scatter_plot <- function(plot, config) {
|
generate_scatter_plot <- function(plot, config) {
|
||||||
@@ -519,7 +531,7 @@ generate_scatter_plot <- function(plot, config) {
|
|||||||
size <- if (!is.null(config$size)) config$size else 1.5
|
size <- if (!is.null(config$size)) config$size else 1.5
|
||||||
position <-
|
position <-
|
||||||
if (!is.null(config$position) && config$position == "jitter") {
|
if (!is.null(config$position) && config$position == "jitter") {
|
||||||
position_jitter(width = 0.2, height = 0)
|
position_jitter(width = 0.3, height = 0.1)
|
||||||
} else {
|
} else {
|
||||||
"identity"
|
"identity"
|
||||||
}
|
}
|
||||||
@@ -728,12 +740,15 @@ generate_interaction_plot_configs <- function(df, type) {
|
|||||||
AUC = c(-6000, 6000)
|
AUC = c(-6000, 6000)
|
||||||
)
|
)
|
||||||
|
|
||||||
overall_plot_configs <- list()
|
stats_plot_configs <- list()
|
||||||
|
stats_boxplot_configs <- list()
|
||||||
delta_plot_configs <- list()
|
delta_plot_configs <- list()
|
||||||
|
|
||||||
# Overall statistics plots
|
# Overall statistics plots
|
||||||
OrfRep <- first(df$OrfRep) # this should correspond to the reference strain
|
OrfRep <- first(df$OrfRep) # this should correspond to the reference strain
|
||||||
|
|
||||||
|
for (plot_type in c("scatter", "box")) {
|
||||||
|
|
||||||
for (var in names(limits_map)) {
|
for (var in names(limits_map)) {
|
||||||
y_limits <- limits_map[[var]]
|
y_limits <- limits_map[[var]]
|
||||||
|
|
||||||
@@ -745,29 +760,45 @@ generate_interaction_plot_configs <- function(df, type) {
|
|||||||
intercept_value <- mean(df[[lm_intercept_col]], na.rm = TRUE)
|
intercept_value <- mean(df[[lm_intercept_col]], na.rm = TRUE)
|
||||||
slope_value <- mean(df[[lm_slope_col]], na.rm = TRUE)
|
slope_value <- mean(df[[lm_slope_col]], na.rm = TRUE)
|
||||||
|
|
||||||
|
# Common plot configuration
|
||||||
plot_config <- list(
|
plot_config <- list(
|
||||||
df = df,
|
df = df,
|
||||||
plot_type = "scatter",
|
|
||||||
x_var = "conc_num_factor_factor",
|
x_var = "conc_num_factor_factor",
|
||||||
y_var = var,
|
y_var = var,
|
||||||
shape = 16,
|
shape = 16,
|
||||||
x_label = unique(df$Drug)[1],
|
x_label = unique(df$Drug)[1],
|
||||||
title = sprintf("%s Scatter RF for %s with SD", OrfRep, var),
|
|
||||||
coord_cartesian = y_limits,
|
coord_cartesian = y_limits,
|
||||||
error_bar = TRUE,
|
|
||||||
error_bar_params = list(
|
|
||||||
color = "red"
|
|
||||||
),
|
|
||||||
x_breaks = unique(df$conc_num_factor_factor),
|
x_breaks = unique(df$conc_num_factor_factor),
|
||||||
x_labels = as.character(unique(df$conc_num)),
|
x_labels = as.character(unique(df$conc_num)),
|
||||||
position = "jitter",
|
|
||||||
smooth = TRUE,
|
|
||||||
lm_line = list(
|
lm_line = list(
|
||||||
intercept = intercept_value,
|
intercept = intercept_value,
|
||||||
slope = slope_value
|
slope = slope_value
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
overall_plot_configs <- append(overall_plot_configs, list(plot_config))
|
|
||||||
|
# Add specific configurations for scatter and box plots
|
||||||
|
if (plot_type == "scatter") {
|
||||||
|
plot_config$plot_type <- "scatter"
|
||||||
|
plot_config$title <- sprintf("%s Scatter RF for %s with SD", OrfRep, var)
|
||||||
|
plot_config$error_bar = TRUE
|
||||||
|
plot_config$error_bar_params <- list(
|
||||||
|
color = "red",
|
||||||
|
center_point = TRUE
|
||||||
|
)
|
||||||
|
plot_config$position <- "jitter"
|
||||||
|
|
||||||
|
# Append to scatter plot configurations
|
||||||
|
stats_plot_configs <- append(stats_plot_configs, list(plot_config))
|
||||||
|
|
||||||
|
} else if (plot_type == "box") {
|
||||||
|
plot_config$plot_type <- "box"
|
||||||
|
plot_config$title <- sprintf("%s Boxplot RF for %s with SD", OrfRep, var)
|
||||||
|
plot_config$position <- "dodge" # Boxplots don't need jitter, use dodge instead
|
||||||
|
|
||||||
|
# Append to boxplot configurations
|
||||||
|
stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config))
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Delta interaction plots
|
# Delta interaction plots
|
||||||
@@ -850,7 +881,8 @@ generate_interaction_plot_configs <- function(df, type) {
|
|||||||
grid_nrow <- ceiling(num_plots / grid_ncol)
|
grid_nrow <- ceiling(num_plots / grid_ncol)
|
||||||
|
|
||||||
return(list(
|
return(list(
|
||||||
list(grid_layout = list(ncol = 2, nrow = 2), plots = overall_plot_configs),
|
list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_plot_configs),
|
||||||
|
list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_boxplot_configs),
|
||||||
list(grid_layout = list(ncol = 4, nrow = grid_nrow), plots = delta_plot_configs)
|
list(grid_layout = list(ncol = 4, nrow = grid_nrow), plots = delta_plot_configs)
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user