From 138ccf7fadba8b0530a6c4a52bcf9c7b7292d97e Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Wed, 2 Oct 2024 16:23:13 -0400 Subject: [PATCH] Dynamically position interaction annotations --- .../apps/r/calculate_interaction_zscores.R | 89 ++++++++++--------- 1 file changed, 45 insertions(+), 44 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index 599ffea6..71064ce6 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -512,10 +512,6 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) { ) } - # Add a new page for the next group, if it exists - if (length(plot_groups) > 1) { - grid.newpage() - } } # Close the PDF device after all plots are done @@ -724,27 +720,13 @@ generate_plate_analysis_plot_configs <- function(variables, df_before = NULL, df generate_interaction_plot_configs <- function(df, type) { - # Set group_vars based on the type (reference or deletion) - if (type == "reference") { - group_vars <- c("OrfRep", "Gene", "num") - } else if (type == "deletion") { - group_vars <- c("OrfRep", "Gene") - } - - # Define the limits for the plots + # Define the y-limits for the plots limits_map <- list( L = c(0, 130), K = c(-20, 160), r = c(0, 1), AUC = c(0, 12500) ) - - delta_limits_map <- list( - L = c(-60, 60), - K = c(-60, 60), - r = c(-0.6, 0.6), - AUC = c(-6000, 6000) - ) stats_plot_configs <- list() stats_boxplot_configs <- list() @@ -758,14 +740,6 @@ generate_interaction_plot_configs <- function(df, type) { for (var in names(limits_map)) { y_limits <- limits_map[[var]] - # 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) - - # Ensure no NA or invalid values in lm_line calculations - intercept_value <- mean(df[[lm_intercept_col]], na.rm = TRUE) - slope_value <- mean(df[[lm_slope_col]], na.rm = TRUE) - # Common plot configuration plot_config <- list( df = df, @@ -775,23 +749,37 @@ generate_interaction_plot_configs <- function(df, type) { x_label = unique(df$Drug)[1], coord_cartesian = y_limits, x_breaks = unique(df$conc_num_factor_factor), - x_labels = as.character(unique(df$conc_num)), - lm_line = list( - intercept = intercept_value, - slope = slope_value - ) + x_labels = as.character(unique(df$conc_num)) ) # 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 <- TRUE plot_config$error_bar_params <- list( 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 =") + ) + + # 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 # Append to scatter plot configurations stats_plot_configs <- append(stats_plot_configs, list(plot_config)) @@ -808,6 +796,19 @@ generate_interaction_plot_configs <- function(df, type) { } # Delta interaction plots + if (type == "reference") { + group_vars <- c("OrfRep", "Gene", "num") + } else if (type == "deletion") { + group_vars <- c("OrfRep", "Gene") + } + + delta_limits_map <- list( + L = c(-60, 60), + K = c(-60, 60), + r = c(-0.6, 0.6), + AUC = c(-6000, 6000) + ) + grouped_data <- df %>% group_by(across(all_of(group_vars))) %>% group_split() @@ -840,16 +841,9 @@ generate_interaction_plot_configs <- function(df, type) { DB_value <- first(group_data$DB, default = 0) SM_value <- first(group_data$SM, default = 0) - annotations <- list( - list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste("ZShift =", Z_Shift_value)), - list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste("lm ZScore =", Z_lm_value)), - list(x = 1, y = y_limits[2] - 0.4 * y_span, label = paste("R-squared =", R_squared_value)), - list(x = 1, y = y_limits[1] + 0.2 * y_span, label = paste("NG =", NG_value)), - list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("DB =", DB_value)), - list(x = 1, y = y_limits[1], label = paste("SM =", SM_value)) - ) - - # lm_line for delta plots + # 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) lm_slope_value <- first(group_data[[lm_slope_col]], default = 0) @@ -861,7 +855,14 @@ generate_interaction_plot_configs <- function(df, type) { x_label = unique(group_data$Drug)[1], title = paste(OrfRepTitle, Gene, num, sep = " "), coord_cartesian = y_limits, - annotations = annotations, + annotations = list( + list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste("ZShift =", Z_Shift_value)), + list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste("lm ZScore =", Z_lm_value)), + list(x = 1, y = y_limits[2] - 0.4 * y_span, label = paste("R-squared =", R_squared_value)), + list(x = 1, y = y_limits[1] + 0.2 * y_span, label = paste("NG =", NG_value)), + list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("DB =", DB_value)), + list(x = 1, y = y_limits[1], label = paste("SM =", SM_value)) + ), error_bar = TRUE, error_bar_params = list( ymin = 0 - (2 * WT_sd_value),