bryan/hartman-server
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Break out plot filtering

Browse Source
This commit is contained in:
Bryan Roessler
2024-09-16 13:55:00 -04:00
parent 4f90330500
commit e07baf7a37
2 changed files with 94 additions and 125 deletions
Download Patch File Download Diff File Expand all files Collapse all files

180
qhtcp-workflow/apps/r/calculate_interaction_zscores.R
View File

@@ -1,11 +1,12 @@
suppressMessages({
library(ggplot2)
library(plotly)
library(htmlwidgets)
library(dplyr)
library(ggthemes)
library(data.table)
library(unix)
library("ggplot2")
library("plotly")
library("htmlwidgets")
library("dplyr")
library("rlang")
library("ggthemes")
library("data.table")
library("unix")
})
options(warn = 2)
@@ -568,13 +569,9 @@ generate_box_plot <- function(plot, config) {
}
generate_interaction_plot_configs <- function(df, variables) {
configs <- list()
# Data frames to collect filtered data and out-of-range data
filtered_data_list <- list()
out_of_range_data_list <- list()
# Define common y-limits for each variable
limits_map <- list(
L = c(-65, 65),
K = c(-65, 65),
@@ -596,44 +593,22 @@ generate_interaction_plot_configs <- function(df, variables) {
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) {
# Get y-limits for the variable
ylim_vals <- limits_map[[variable]]
# Extract precomputed linear model coefficients
lm_line <- list(
intercept = df[[paste0("lm_intercept_", variable)]],
slope = df[[paste0("lm_slope_", variable)]]
)
# Filter the data based on y-limits and missing values
y_var_sym <- sym(variable)
x_var_sym <- sym("conc_num_factor")
# Identify missing data and out-of-range data
missing_data <- df %>% filter(is.na(!!x_var_sym) | is.na(!!y_var_sym))
out_of_range_data <- df %>% filter(
!is.na(!!y_var_sym) &
(!!y_var_sym < min(ylim_vals, na.rm = TRUE) | !!y_var_sym > max(ylim_vals, na.rm = TRUE))
)
# Combine missing data and out-of-range data
data_to_filter_out <- bind_rows(missing_data, out_of_range_data) %>% distinct()
# Filtered data for plotting
filtered_data <- df %>% anti_join(data_to_filter_out, by = names(df))
# Collect the filtered data and out-of-range data
filtered_data_list[[variable]] <- filtered_data
out_of_range_data_list[[variable]] <- data_to_filter_out
# Calculate x and y positions for annotations based on filtered data
x_levels <- levels(filtered_data$conc_num_factor)
x_pos <- mean(seq_along(x_levels)) # Midpoint of x-axis
y_min <- min(ylim_vals)
y_max <- max(ylim_vals)
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]]
y_min <- min(y_range)
y_max <- max(y_range)
y_span <- y_max - y_min
# Adjust y positions as fractions of y-span
@@ -650,7 +625,7 @@ generate_interaction_plot_configs <- function(df, variables) {
y_pos <- annotation_positions[[annotation_name]]
label_func <- annotation_labels[[annotation_name]]
if (!is.null(label_func)) {
label <- label_func(df, variable)
label <- label_func(df_filtered, variable)
list(x = x_pos, y = y_pos, label = label)
} else {
message(paste("Warning: No annotation function found for", annotation_name))
@@ -663,48 +638,40 @@ generate_interaction_plot_configs <- function(df, variables) {
# Create scatter plot config
configs[[length(configs) + 1]] <- list(
df = filtered_data,
df = df_filtered,
x_var = "conc_num_factor",
y_var = variable,
plot_type = "scatter",
title = sprintf("%s %s", df$OrfRep[1], df$Gene[1]),
ylim_vals = ylim_vals,
title = sprintf("%s %s", df_filtered$OrfRep[1], df_filteredGene[1]),
ylim_vals = y_range,
annotations = annotations,
lm_line = lm_line,
lm_line = lm_lines[[variable]],
error_bar = TRUE,
x_breaks = levels(filtered_data$conc_num_factor),
x_labels = levels(filtered_data$conc_num_factor),
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 = ylim_vals # Use the actual y-limits
coord_cartesian = y_range # Use the actual y-limits
)
# Create box plot config
configs[[length(configs) + 1]] <- list(
df = filtered_data,
df = df_filtered,
x_var = "conc_num_factor",
y_var = variable,
plot_type = "box",
title = sprintf("%s %s (Boxplot)", df$OrfRep[1], df$Gene[1]),
ylim_vals = ylim_vals,
title = sprintf("%s %s (Boxplot)", df_filtered$OrfRep[1], df_filtered$Gene[1]),
ylim_vals = y_range,
annotations = annotations,
error_bar = FALSE,
x_breaks = unique(filtered_data$conc_num_factor),
x_labels = unique(as.character(filtered_data$conc_num)),
x_label = unique(df$Drug[1]),
coord_cartesian = ylim_vals
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
)
}
# Combine the filtered data and out-of-range data into data frames
filtered_data_df <- bind_rows(filtered_data_list, .id = "variable")
out_of_range_data_df <- bind_rows(out_of_range_data_list, .id = "variable")
return(list(
configs = configs,
filtered_data = filtered_data_df,
out_of_range_data = out_of_range_data_df
))
return(configs)
}
generate_rank_plot_configs <- function(df, interaction_vars, rank_vars = c("L", "K"), is_lm = FALSE, adjust = FALSE) {
@@ -822,6 +789,54 @@ 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) {
# Initialize lists to store lm lines and filtered data
lm_lines <- list()
# Print out NA and out-of-range data separately
for (variable in variables) {
# Get y-limits for the variable
ylim_vals <- limits_map[[variable]]
# Extract precomputed linear model coefficients
lm_lines[[variable]] <- list(
intercept = df[[paste0("lm_intercept_", variable)]],
slope = df[[paste0("lm_slope_", variable)]]
)
# Convert variable name to symbol for dplyr
y_var_sym <- sym(variable)
# Identify missing data and print it
missing_data <- df %>% filter(is.na(!!y_var_sym))
if (nrow(missing_data) > 0) {
message("Missing data for variable ", variable, ":")
print(missing_data)
}
# Identify out-of-range data and print it
out_of_range_data <- df %>% filter(
!is.na(!!y_var_sym) &
(!!y_var_sym < min(ylim_vals, na.rm = TRUE) | !!y_var_sym > max(ylim_vals, na.rm = TRUE))
)
if (nrow(out_of_range_data) > 0) {
message("Out-of-range data for variable ", variable, ":")
print(out_of_range_data)
}
}
# Perform all filtering at once for all variables
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
))
}
main <- function() {
lapply(names(args$experiments), function(exp_name) {
exp <- args$experiments[[exp_name]]
@@ -1151,22 +1166,11 @@ main <- function() {
# Create interaction plots
message("Generating reference interaction plots")
results <- generate_interaction_plot_configs(zscores_interactions_reference_joined, interaction_vars)
if (nrow(results$out_of_range_data) > 0) {
message("Out-of-range data:")
print(results$out_of_range_data %>% select("OrfRep", "Gene", "num",
"conc_num", "conc_num_factor", config$x_var, config$y_var))
}
reference_plot_configs <- results$configs
reference_plot_configs <- generate_interaction_plot_configs(zscores_interactions_reference_joined, interaction_vars)
generate_and_save_plots(out_dir, "RF_interactionPlots", reference_plot_configs, grid_layout = list(ncol = 4, nrow = 3))
message("Generating deletion interaction plots")
results <- generate_interaction_plot_configs(zscores_interactions_joined, interaction_vars)
if (nrow(results$out_of_range_data) > 0) {
message("Out-of-range data:")
print(results$out_of_range_data)
}
deletion_plot_configs <- results$configs
deletion_plot_configs <- generate_interaction_plot_configs(zscores_interactions_joined, interaction_vars)
generate_and_save_plots(out_dir, "InteractionPlots", deletion_plot_configs, grid_layout = list(ncol = 4, nrow = 3))
# Define conditions for enhancers and suppressors
@@ -1253,10 +1257,10 @@ main <- function() {
ungroup() %>%
rowwise() %>%
mutate(
lm_R_squared_L = summary(lm(Z_lm_L ~ Avg_Zscore_L))$r.squared,
lm_R_squared_K = summary(lm(Z_lm_K ~ Avg_Zscore_K))$r.squared,
lm_R_squared_r = summary(lm(Z_lm_r ~ Avg_Zscore_r))$r.squared,
lm_R_squared_AUC = summary(lm(Z_lm_AUC ~ Avg_Zscore_AUC))$r.squared,
lm_R_squared_L = if (n() > 1) summary(lm(Z_lm_L ~ Avg_Zscore_L))$r.squared else NA,
lm_R_squared_K = if (n() > 1) summary(lm(Z_lm_K ~ Avg_Zscore_K))$r.squared else NA,
lm_R_squared_r = if (n() > 1) summary(lm(Z_lm_r ~ Avg_Zscore_r))$r.squared else NA,
lm_R_squared_AUC = if (n() > 1) summary(lm(Z_lm_AUC ~ Avg_Zscore_AUC))$r.squared else NA,
Overlap = case_when(
Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both",