소스 검색

Dynamically position interaction annotations

Bryan Roessler 7 달 전
부모
커밋
138ccf7fad
1개의 변경된 파일45개의 추가작업 그리고 44개의 파일을 삭제
  1. 45 44
      qhtcp-workflow/apps/r/calculate_interaction_zscores.R

+ 45 - 44
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),