Skip empty plots to fix grid.arrange() error

This commit is contained in:
2024-10-06 16:06:45 -04:00
parent faa82e0af4
commit 0c60980ba9

View File

@@ -509,30 +509,23 @@ calculate_interaction_scores <- function(df, df_bg, type, overlap_threshold = 2)
generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width = 12, page_height = 8) {
message("Generating ", filename, ".pdf and ", filename, ".html")
# Check if we're dealing with multiple plot groups
plot_groups <- if ("plots" %in% names(plot_configs)) {
list(plot_configs) # Single group
} else {
plot_configs # Multiple groups
}
# Open the PDF device once for all plots
pdf(file.path(out_dir, paste0(filename, ".pdf")), width = page_width, height = page_height)
# Loop through each plot group
for (group in plot_groups) {
static_plots <- list()
plotly_plots <- list()
# Retrieve grid layout if it exists, otherwise skip
grid_layout <- group$grid_layout
plots <- group$plots
for (i in seq_along(plots)) {
config <- plots[[i]]
for (i in seq_along(group$plots)) {
config <- group$plots[[i]]
df <- config$df
# Filter points outside of y-limits if specified
# Filter and debug out-of-bounds data
if (!is.null(config$ylim_vals)) {
out_of_bounds <- df %>%
filter(
@@ -540,14 +533,11 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
.data[[config$y_var]] < config$ylim_vals[1] |
.data[[config$y_var]] > config$ylim_vals[2]
)
# Print rows being filtered out
if (nrow(out_of_bounds) > 0) {
message("Filtered ", nrow(out_of_bounds), " row(s) from '", config$title, "' because ", config$y_var,
" is outside of y-limits: [", config$ylim_vals[1], ", ", config$ylim_vals[2], "]:")
print(out_of_bounds %>% select(OrfRep, Gene, num, Drug, scan, Plate, Row, Col, conc_num, all_of(config$y_var)), width = 1000)
# print(out_of_bounds %>% select(OrfRep, Gene, num, Drug, scan, Plate, Row, Col, conc_num, all_of(config$y_var)), width = 1000)
}
df <- df %>%
filter(
!is.na(.data[[config$y_var]]) &
@@ -556,13 +546,17 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
)
}
# Filter NAs if specified
# Filter NAs
if (!is.null(config$filter_na) && config$filter_na) {
df <- df %>%
filter(!is.na(.data[[config$y_var]]))
}
# Set up aes mapping based on plot type
if (nrow(df) == 0) {
message("No data available after filtering for plot ", config$title)
next # Skip this plot if no data is available
}
aes_mapping <- if (config$plot_type == "bar") {
if (!is.null(config$color_var)) {
aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
@@ -587,16 +581,14 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
plot <- ggplot(df, aes_mapping) + theme_publication(legend_position = config$legend_position)
# Add appropriate plot layer or helper function based on plot type
plot <- switch(config$plot_type,
"scatter" = generate_scatter_plot(plot, config),
"box" = generate_boxplot(plot, config),
"density" = plot + geom_density(),
"bar" = plot + geom_bar(),
plot # default (unused)
plot # default
)
# Add labels and title
if (!is.null(config$title)) {
plot <- plot + ggtitle(config$title)
if (!is.null(config$title_size)) {
@@ -607,44 +599,21 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
if (!is.null(config$y_label)) plot <- plot + ylab(config$y_label)
if (!is.null(config$coord_cartesian)) plot <- plot + coord_cartesian(ylim = config$coord_cartesian)
# Add annotations if specified
if (!is.null(config$annotations)) {
for (annotation in config$annotations) {
plot <- plot +
annotate(
"text",
x = ifelse(is.null(annotation$x), 0, annotation$x),
y = ifelse(is.null(annotation$y), Inf, annotation$y),
label = annotation$label,
hjust = ifelse(is.null(annotation$hjust), 0.5, annotation$hjust),
vjust = ifelse(is.null(annotation$vjust), 1, annotation$vjust),
size = ifelse(is.null(annotation$size), 3, annotation$size),
color = ifelse(is.null(annotation$color), "black", annotation$color)
)
}
}
# Convert ggplot to plotly for interactive version
plotly_plot <- suppressWarnings(plotly::ggplotly(plot))
# Store both static and interactive versions
static_plots[[i]] <- plot
plotly_plots[[i]] <- plotly_plot
}
# Print the plots in the current group to the PDF
grid_layout <- group$grid_layout
if (!is.null(grid_layout)) {
# Set grid_ncol to 1 if not specified
if (is.null(grid_layout$ncol)) {
grid_layout$ncol <- 1
}
# If ncol is set but nrow is not, calculate nrow dynamically based on num_plots
if (!is.null(grid_layout$ncol) && is.null(grid_layout$nrow)) {
num_plots <- length(static_plots)
nrow <- ceiling(num_plots / grid_layout$ncol)
# message("No nrow provided, automatically using nrow = ", nrow)
grid_layout$nrow <- nrow
grid_layout$nrow <- ceiling(num_plots / grid_layout$ncol)
}
total_spots <- grid_layout$nrow * grid_layout$ncol
@@ -655,24 +624,26 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
static_plots <- c(static_plots, replicate(total_spots - num_plots, nullGrob(), simplify = FALSE))
}
# Print a page of gridded plots
tryCatch({
grid.arrange(
grobs = static_plots,
ncol = grid_layout$ncol,
nrow = grid_layout$nrow)
nrow = grid_layout$nrow
)
}, error = function(e) {
message("Error in grid.arrange: ", e$message)
print(static_plots)
})
} else {
# Print individual plots on separate pages if no grid layout
for (plot in static_plots) {
print(plot)
}
}
}
# Close the PDF device after all plots are done
dev.off()
# Save HTML file with interactive plots if needed
out_html_file <- file.path(out_dir, paste0(filename, ".html"))
message("Saving combined HTML file: ", out_html_file)
htmltools::save_html(
@@ -681,6 +652,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
)
}
generate_scatter_plot <- function(plot, config) {
# Define the points
@@ -1118,7 +1090,7 @@ generate_interaction_plot_configs <- function(df_summary, df_interactions, type)
x_breaks = unique(group_data$conc_num_factor_factor),
x_labels = as.character(unique(group_data$conc_num)),
ylim_vals = y_limits,
filter_na = TRUE,
# filter_na = TRUE,
lm_line = list(
intercept = lm_intercept_value,
slope = lm_slope_value,