From 328fe1f116dc02e169b014b66833681465207dae Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Fri, 4 Oct 2024 13:56:30 -0400 Subject: [PATCH] Move automatic nrow calculation to generate_and_save_plots --- .../apps/r/calculate_interaction_zscores.R | 178 +++++++++--------- 1 file changed, 91 insertions(+), 87 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 03de38b3..0adf5b5a 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -513,20 +513,67 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) { static_plots <- list() plotly_plots <- list() + # Retrieve grid layout if it exists, otherwise skip grid_layout <- group$grid_layout plots <- group$plots + # Only handle grid layout if it exists + 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(plots) + nrow <- ceiling(num_plots / grid_layout$ncol) + message("No nrow provided, automatically using nrow = ", nrow) + grid_layout$nrow <- nrow + } + } + for (i in seq_along(plots)) { config <- plots[[i]] df <- config$df + # Filter points outside of y-limits if specified + if (!is.null(config$ylim_vals)) { + out_of_bounds_df <- df %>% + filter( + is.na(.data[[config$y_var]]) | + .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_df) > 0) { + message("Filtered out rows outside y-limits:") + print(out_of_bounds_df) + } + + # Filter the valid data for plotting + df <- df %>% + filter( + !is.na(.data[[config$y_var]]) & + .data[[config$y_var]] >= config$ylim_vals[1] & + .data[[config$y_var]] <= config$ylim_vals[2] + ) + } + # Set up aes mapping based on plot type - aes_mapping <- if (config$plot_type == "bar" || config$plot_type == "density") { + 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]]) } else { aes(x = .data[[config$x_var]]) } + } else if (config$plot_type == "density") { + if (!is.null(config$color_var)) { + aes(x = .data[[config$x_var]], color = .data[[config$color_var]]) + } else { + aes(x = .data[[config$x_var]]) + } } else { if (!is.null(config$y_var) && !is.null(config$color_var)) { aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]]) @@ -573,63 +620,28 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) { # Add error bars if specified if (!is.null(config$error_bar) && config$error_bar) { - # Check if a fixed color is provided or if it should come from a data column - error_bar_color <- config$error_bar_params$color - - if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) { - # Check if ymin and ymax are constants or column names - if (is.numeric(config$error_bar_params$ymin) && is.numeric(config$error_bar_params$ymax)) { - plot <- plot + geom_errorbar( - aes(x = .data[[config$x_var]]), - ymin = config$error_bar_params$ymin, - ymax = config$error_bar_params$ymax + y_mean_col <- paste0("mean_", config$y_var) + y_sd_col <- paste0("sd_", config$y_var) + # If color_var is provided and no fixed error bar color is set, use aes() to map color dynamically + if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) { + plot <- plot + geom_errorbar( + aes( + x = .data[[config$x_var]], + ymin = .data[[y_mean_col]] - .data[[y_sd_col]], + ymax = .data[[y_mean_col]] + .data[[y_sd_col]], + color = .data[[config$color_var]] # Dynamic color from the data ) - } else { - # Map color_var to data if available - if (!is.null(config$color_var)) { - plot <- plot + geom_errorbar( - aes( - x = .data[[config$x_var]], - ymin = .data[[config$error_bar_params$ymin]], - ymax = .data[[config$error_bar_params$ymax]], - color = .data[[config$color_var]] - ) - ) - } else { - plot <- plot + geom_errorbar( - aes( - x = .data[[config$x_var]], - ymin = .data[[config$error_bar_params$ymin]], - ymax = .data[[config$error_bar_params$ymax]] - ) - ) - } - } + ) } else { - # Use mean and SD columns from df - y_mean_col <- paste0("mean_", config$y_var) - y_sd_col <- paste0("sd_", config$y_var) - - if (y_mean_col %in% colnames(df) && y_sd_col %in% colnames(df)) { - if (!is.null(config$color_var)) { - plot <- plot + geom_errorbar( - aes( - x = .data[[config$x_var]], - ymin = .data[[y_mean_col]] - .data[[y_sd_col]], - ymax = .data[[y_mean_col]] + .data[[y_sd_col]], - color = .data[[config$color_var]] - ) - ) - } else { - plot <- plot + geom_errorbar( - aes( - x = .data[[config$x_var]], - ymin = .data[[y_mean_col]] - .data[[y_sd_col]], - ymax = .data[[y_mean_col]] + .data[[y_sd_col]] - ) - ) - } - } + # If a fixed error bar color is set, use it outside aes + plot <- plot + geom_errorbar( + aes( + x = .data[[config$x_var]], + ymin = .data[[y_mean_col]] - .data[[y_sd_col]], + ymax = .data[[y_mean_col]] + .data[[y_sd_col]] + ), + color = config$error_bar_params$color # Fixed color + ) } } @@ -869,6 +881,7 @@ generate_interaction_plot_configs <- function(df, type) { # Common plot configuration plot_config <- list( df = df, + plot_type = plot_type, x_var = "conc_num_factor_factor", y_var = var, shape = 16, @@ -880,40 +893,35 @@ generate_interaction_plot_configs <- function(df, type) { # 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( - y_sd_prefix = "WT_sd_", - y_mean_prefix = "mean_", color = "red", center_point = TRUE ) plot_config$position <- "jitter" - annotations <- list( - list(x = 0.25, y = y_limits[1] + 0.1 * y_span, label = " NG ="), # Slightly above y-min - list(x = 0.25, y = y_limits[1] + 0.05 * y_span, label = " DB ="), - list(x = 0.25, y = y_limits[1], label = " SM =") - ) + 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( - list(x = x_val, y = y_limits[1] + 0.1 * y_span, label = first(current_df$NG, default = 0)), - list(x = x_val, y = y_limits[1] + 0.05 * y_span, label = first(current_df$DB, default = 0)), - list(x = x_val, y = y_limits[1], label = first(current_df$SM, default = 0)) - )) - } + # 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( + list(x = x_val, y = y_limits[1] + 0.1 * y_span, label = first(current_df$NG, default = 0)), + list(x = x_val, y = y_limits[1] + 0.05 * y_span, label = first(current_df$DB, default = 0)), + list(x = x_val, y = y_limits[1], label = first(current_df$SM, default = 0)) + )) + } - plot_config$annotations <- annotations + plot_config$annotations <- annotations - # 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 @@ -1001,6 +1009,7 @@ generate_interaction_plot_configs <- function(df, type) { x_breaks = unique(group_data$conc_num_factor_factor), x_labels = as.character(unique(group_data$conc_num)), ylim_vals = y_limits, + y_filter = FALSE, lm_line = list( intercept = lm_intercept_value, slope = lm_slope_value @@ -1010,15 +1019,10 @@ generate_interaction_plot_configs <- function(df, type) { } } - # Calculate dynamic grid layout - grid_ncol <- 4 - num_plots <- length(delta_plot_configs) - grid_nrow <- ceiling(num_plots / grid_ncol) - return(list( - 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 = 2), plots = stats_plot_configs), # nrow will be calculated dynamically + list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs), # nrow will be calculated dynamically + list(grid_layout = list(ncol = 4), plots = delta_plot_configs) # nrow will be calculated dynamically )) } @@ -1412,9 +1416,9 @@ main <- function() { plot_configs = delta_bg_outside_2sd_k_plot_configs) ) - furrr::future_map(plot_configs, function(config) { - generate_and_save_plots(config$out_dir, config$filename, config$plot_configs) - }, .options = furrr_options(seed = TRUE)) + # furrr::future_map(plot_configs, function(config) { + # generate_and_save_plots(config$out_dir, config$filename, config$plot_configs) + # }, .options = furrr_options(seed = TRUE)) bg_strains <- c("YDL227C") lapply(bg_strains, function(strain) {