diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 44e29b29..d859c8b6 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -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) + " 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) } - 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 - grid.arrange( - grobs = static_plots, - ncol = grid_layout$ncol, - nrow = grid_layout$nrow) - + tryCatch({ + grid.arrange( + grobs = static_plots, + ncol = grid_layout$ncol, + 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,