From bbf2d630b9cea9bf6f5b1e39a9ce0998a8df315e Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Fri, 4 Oct 2024 18:42:58 -0400 Subject: [PATCH] Plot interaction plots in chunks of 12 for pagination --- .../apps/r/calculate_interaction_zscores.R | 54 ++++++++++--------- 1 file changed, 28 insertions(+), 26 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index b1d0ff85..fa99684c 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -683,7 +683,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width ncol = grid_layout$ncol, nrow = grid_layout$nrow ) - grid.newpage() + # grid.newpage() } } @@ -919,13 +919,13 @@ generate_interaction_plot_configs <- function(df, type) { ) plot_config$position <- "jitter" + # Cannot figure out how to place these properly for discrete x-axis so let's be hacky annotations <- list( list(x = 0.25, y = y_limits[1] + 0.1 * y_span, label = " NG:"), list(x = 0.25, y = y_limits[1] + 0.05 * y_span, label = " DB:"), list(x = 0.25, y = y_limits[1], label = " SM:") ) - # Loop over unique x values and add NG, DB, SM values at calculated y positions for (x_val in unique(df$conc_num_factor_factor)) { current_df <- df %>% filter(.data[[plot_config$x_var]] == x_val) annotations <- append(annotations, list( @@ -941,9 +941,8 @@ generate_interaction_plot_configs <- function(df, type) { } else if (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 + plot_config$position <- "dodge" - # Append to boxplot configurations stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config)) } } @@ -982,20 +981,15 @@ generate_interaction_plot_configs <- function(df, type) { y_limits <- delta_limits_map[[var]] y_span <- y_limits[2] - y_limits[1] - # Error bars WT_sd_value <- first(group_data[[paste0("WT_sd_", var)]], default = 0) - - # Z_Shift and lm values Z_Shift_value <- round(first(group_data[[paste0("Z_Shift_", var)]], default = 0), 2) Z_lm_value <- round(first(group_data[[paste0("Z_lm_", var)]], default = 0), 2) R_squared_value <- round(first(group_data[[paste0("R_Squared_", var)]], default = 0), 2) - # NG, DB, SM values NG_value <- first(group_data$NG, default = 0) DB_value <- first(group_data$DB, default = 0) SM_value <- first(group_data$SM, default = 0) - # Use the pre-calculated lm intercept and slope from the dataframe lm_intercept_col <- paste0("lm_intercept_", var) lm_slope_col <- paste0("lm_slope_", var) lm_intercept_value <- first(group_data[[lm_intercept_col]], default = 0) @@ -1037,11 +1031,14 @@ generate_interaction_plot_configs <- function(df, type) { } } - # Return plot configs - return(list( - list(grid_layout = list(ncol = 2), plots = stats_plot_configs), - list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs), - list(grid_layout = list(ncol = 4), plots = delta_plot_configs[1:24]) # nrow calculated dynamically + # Group delta plots in chunks of 12 + chunk_size <- 12 + delta_plot_chunks <- split(delta_plot_configs, ceiling(seq_along(delta_plot_configs) / chunk_size)) + + return(c( + list(list(grid_layout = list(ncol = 2), plots = stats_plot_configs)), + list(list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs)), + lapply(delta_plot_chunks, function(chunk) list(grid_layout = list(ncol = 4), plots = chunk)) )) } @@ -1071,6 +1068,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla df = df, x_var = rank_var, y_var = zscore_var, + x_label = "Rank", plot_type = "scatter", title = paste(y_label, "vs. Rank for", variable, "above", sd_band), sd_band = sd_band, @@ -1090,13 +1088,13 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla # Add specific annotations for plots with annotations plot_config$annotations <- list( list( - x = median(df[[rank_var]], na.rm = TRUE), - y = max(df[[zscore_var]], na.rm = TRUE) * 0.9, + x = nrow(df) / 2, + y = 10, label = paste("Deletion Enhancers =", num_enhancers) ), list( - x = median(df[[rank_var]], na.rm = TRUE), - y = min(df[[zscore_var]], na.rm = TRUE) * 0.9, + x = nrow(df) / 2, + y = -10, label = paste("Deletion Suppressors =", num_suppressors) ) ) @@ -1124,7 +1122,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla return(list(grid_layout = list(ncol = 3), plots = plot_configs)) } -generate_correlation_plot_configs <- function(df, correlation_stats) { +generate_correlation_plot_configs <- function(df) { # Define relationships for different-variable correlations relationships <- list( list(x = "L", y = "K"), @@ -1421,7 +1419,7 @@ main <- function() { list(out_dir = out_dir_qc, filename = "plate_analysis_boxplots", plot_configs = plate_analysis_boxplot_configs, page_width = 18, page_height = 9), list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros", - plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 12, page_height = 8), + plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 14, page_height = 9), list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros_boxplots", plot_configs = plate_analysis_no_zeros_boxplot_configs, page_width = 18, page_height = 9), list(out_dir = out_dir_qc, filename = "L_vs_K_for_strains_2SD_outside_mean_K", @@ -1431,10 +1429,10 @@ main <- function() { ) # Parallelize background and quality control plot generation - # furrr::future_map(plot_configs, function(config) { - # generate_and_save_plots(config$out_dir, config$filename, config$plot_configs, - # page_width = config$page_width, page_height = config$page_height) - # }, .options = furrr_options(seed = TRUE)) + furrr::future_map(plot_configs, function(config) { + generate_and_save_plots(config$out_dir, config$filename, config$plot_configs, + page_width = config$page_width, page_height = config$page_height) + }, .options = furrr_options(seed = TRUE)) # Loop over background strains # TODO currently only tested against one strain, if we want to do multiple strains we'll @@ -1494,7 +1492,7 @@ main <- function() { message("Generating reference interaction plots") reference_plot_configs <- generate_interaction_plot_configs(df_interactions_reference_joined, "reference") - generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 18, page_height = 16) + generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 16, page_height = 16) message("Setting missing deletion values to the highest theoretical value at each drug conc for L") df_deletion <- df_na_stats %>% # formerly X2 @@ -1609,4 +1607,8 @@ main <- function() { main() # For future simplification of joined dataframes -# df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats")) \ No newline at end of file +# df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats")) +# # Add a custom horizontal line (for rank plots) +# if (!is.null(config$hline) && config$hline) { +# plot <- plot + geom_hline(yintercept = config$hline, linetype = "dashed", color = "black") +# } \ No newline at end of file