From b13f2df26b7397be1b0570d40d99a6ec851dc863 Mon Sep 17 00:00:00 2001 From: Bryan Roessler Date: Mon, 16 Sep 2024 14:19:52 -0400 Subject: [PATCH] Refactor interaction plot configs --- .../apps/r/calculate_interaction_zscores.R | 131 +++++++++--------- 1 file changed, 62 insertions(+), 69 deletions(-) diff --git a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R index ec9138e6..8f590039 100644 --- a/qhtcp-workflow/apps/r/calculate_interaction_zscores.R +++ b/qhtcp-workflow/apps/r/calculate_interaction_zscores.R @@ -578,102 +578,99 @@ generate_interaction_plot_configs <- function(df, variables) { r = c(-0.65, 0.65), AUC = c(-6500, 6500) ) - - # Define functions to generate annotation labels - annotation_labels <- list( - ZShift = function(df, var) { - val <- df[[paste0("Z_Shift_", var)]] - paste("ZShift =", round(val, 2)) - }, - lm_ZScore = function(df, var) { - val <- df[[paste0("Z_lm_", var)]] - paste("lm ZScore =", round(val, 2)) - }, - NG = function(df, var) paste("NG =", df$NG), - DB = function(df, var) paste("DB =", df$DB), - SM = function(df, var) paste("SM =", df$SM) - ) - results <- filter_data_for_plots(df, variables, limits_map) - df_filtered <- results$df_filtered - lm_lines <- filtered_results$lm_lines - - # Iterate over each variable to create plot configurations - for (variable in variables) { - - # Calculate x and y positions for annotations based on filtered data - x_levels <- levels(df_filtered$conc_num_factor) - num_levels <- length(x_levels) - x_pos <- (1 + num_levels) / 2 # Midpoint of x-axis positions - - y_range <- limits_map[[variable]] + df_filtered <- filter_data_for_plots(df, variables, limits_map)$filtered_data + + # Define annotation label functions + generate_annotation_labels <- function(df, var, annotation_name) { + switch(annotation_name, + ZShift = paste("ZShift =", round(df[[paste0("Z_Shift_", var)]], 2)), + lm_ZScore = paste("lm ZScore =", round(df[[paste0("Z_lm_", var)]], 2)), + NG = paste("NG =", df$NG), + DB = paste("DB =", df$DB), + SM = paste("SM =", df$SM), + NULL # Default case for unrecognized annotation names + ) + } + + # Define annotation positions relative to the y-axis range + calculate_annotation_positions <- function(y_range) { y_min <- min(y_range) y_max <- max(y_range) y_span <- y_max - y_min - - # Adjust y positions as fractions of y-span - annotation_positions <- list( + + list( ZShift = y_max - 0.1 * y_span, lm_ZScore = y_max - 0.2 * y_span, NG = y_min + 0.2 * y_span, DB = y_min + 0.1 * y_span, SM = y_min + 0.05 * y_span ) - + } + + # Create configurations for each variable + for (variable in variables) { + + y_range <- limits_map[[variable]] + annotation_positions <- calculate_annotation_positions(y_range) + lm_line <- list( + intercept = df_filtered[[paste0("lm_intercept_", variable)]], + slope = df_filtered[[paste0("lm_slope_", variable)]] + ) + + # Determine x-axis midpoint + num_levels <- length(levels(df_filtered$conc_num_factor)) + x_pos <- (1 + num_levels) / 2 # Midpoint of x-axis + # Generate annotations annotations <- lapply(names(annotation_positions), function(annotation_name) { + label <- generate_annotation_labels(df_filtered, variable, annotation_name) y_pos <- annotation_positions[[annotation_name]] - label_func <- annotation_labels[[annotation_name]] - if (!is.null(label_func)) { - label <- label_func(df_filtered, variable) + if (!is.null(label)) { list(x = x_pos, y = y_pos, label = label) } else { - message(paste("Warning: No annotation function found for", annotation_name)) + message(paste("Warning: No annotation found for", annotation_name)) NULL } }) - + # Remove NULL annotations annotations <- Filter(Negate(is.null), annotations) - - # Create scatter plot config - configs[[length(configs) + 1]] <- list( + + # Shared plot settings + plot_settings <- list( df = df_filtered, x_var = "conc_num_factor", y_var = variable, - plot_type = "scatter", - title = sprintf("%s %s", df_filtered$OrfRep[1], df_filteredGene[1]), ylim_vals = y_range, annotations = annotations, - lm_line = lm_lines[[variable]], - error_bar = TRUE, - x_breaks = levels(df_filtered$conc_num_factor), - x_labels = levels(df_filtered$conc_num_factor), - x_label = unique(df$Drug[1]), - position = "jitter", - coord_cartesian = y_range # Use the actual y-limits - ) - - # Create box plot config - configs[[length(configs) + 1]] <- list( - df = df_filtered, - x_var = "conc_num_factor", - y_var = variable, - plot_type = "box", - title = sprintf("%s %s (Boxplot)", df_filtered$OrfRep[1], df_filtered$Gene[1]), - ylim_vals = y_range, - annotations = annotations, - error_bar = FALSE, + lm_line = lm_line, x_breaks = levels(df_filtered$conc_num_factor), x_labels = levels(df_filtered$conc_num_factor), x_label = unique(df_filtered$Drug[1]), - coord_cartesian = y_range + coord_cartesian = y_range # Use the actual y-limits ) + + # Scatter plot config + configs[[length(configs) + 1]] <- modifyList(plot_settings, list( + plot_type = "scatter", + title = sprintf("%s %s", df_filtered$OrfRep[1], df_filtered$Gene[1]), + error_bar = TRUE, + position = "jitter" + )) + + # Box plot config + configs[[length(configs) + 1]] <- modifyList(plot_settings, list( + plot_type = "box", + title = sprintf("%s %s (Boxplot)", df_filtered$OrfRep[1], df_filtered$Gene[1]), + error_bar = FALSE + )) } - + return(configs) } + generate_rank_plot_configs <- function(df, interaction_vars, rank_vars = c("L", "K"), is_lm = FALSE, adjust = FALSE) { for (var in interaction_vars) { @@ -789,7 +786,7 @@ filter_and_print_non_finite <- function(df, vars_to_check, print_vars) { df %>% filter(if_all(all_of(vars_to_check), is.finite)) } -filter_data_for_plots <- function(df, variables, limits_map) { +filter_data_for_plots <- function(df, variables, limits_map = NULL) { # Initialize lists to store lm lines and filtered data lm_lines <- list() @@ -830,11 +827,7 @@ filter_data_for_plots <- function(df, variables, limits_map) { df_filtered <- df %>% filter(across(all_of(variables), ~ !is.na(.))) %>% filter(across(all_of(variables), ~ between(., limits_map[[cur_column()]][1], limits_map[[cur_column()]][2]), .names = "filter_{col}")) - # Return the filtered dataframe and lm lines - return(list( - df_filtered = df_filtered, - lm_lines = lm_lines - )) + return(df_filtered) } main <- function() {