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

Plot interaction plots in chunks of 12 for pagination

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-04 18:42:58 -04:00
parent 83576d6e94
commit bbf2d630b9
1 changed files with 28 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -683,7 +683,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
ncol = grid_layout$ncol, ncol = grid_layout$ncol,
nrow = grid_layout$nrow nrow = grid_layout$nrow
) )
grid.newpage() # grid.newpage()
} }
} }
@@ -919,13 +919,13 @@ generate_interaction_plot_configs <- function(df, type) {
) )
plot_config$position <- "jitter" plot_config$position <- "jitter"
# Cannot figure out how to place these properly for discrete x-axis so let's be hacky
annotations <- list( 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.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] + 0.05 * y_span, label = " DB:"),
list(x = 0.25, y = y_limits[1], label = " SM:") 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)) { for (x_val in unique(df$conc_num_factor_factor)) {
current_df <- df %>% filter(.data[[plot_config$x_var]] == x_val) current_df <- df %>% filter(.data[[plot_config$x_var]] == x_val)
annotations <- append(annotations, list( annotations <- append(annotations, list(
@@ -941,9 +941,8 @@ generate_interaction_plot_configs <- function(df, type) {
} else if (plot_type == "box") { } else if (plot_type == "box") {
plot_config$title <- sprintf("%s Boxplot RF for %s with SD", OrfRep, var) 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 plot_config$position <- "dodge"
# Append to boxplot configurations
stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config)) stats_boxplot_configs <- append(stats_boxplot_configs, list(plot_config))
} }
} }
@@ -982,20 +981,15 @@ generate_interaction_plot_configs <- function(df, type) {
y_limits <- delta_limits_map[[var]] y_limits <- delta_limits_map[[var]]
y_span <- y_limits[2] - y_limits[1] y_span <- y_limits[2] - y_limits[1]
# Error bars
WT_sd_value <- first(group_data[[paste0("WT_sd_", var)]], default = 0) WT_sd_value <- first(group_data[[paste0("WT_sd_", var)]], default = 0)
# Z_Shift and lm values
Z_Shift_value <- round(first(group_data[[paste0("Z_Shift_", var)]], default = 0), 2) Z_Shift_value <- round(first(group_data[[paste0("Z_Shift_", var)]], default = 0), 2)
Z_lm_value <- round(first(group_data[[paste0("Z_lm_", var)]], default = 0), 2) Z_lm_value <- round(first(group_data[[paste0("Z_lm_", var)]], default = 0), 2)
R_squared_value <- round(first(group_data[[paste0("R_Squared_", var)]], default = 0), 2) R_squared_value <- round(first(group_data[[paste0("R_Squared_", var)]], default = 0), 2)
# NG, DB, SM values
NG_value <- first(group_data$NG, default = 0) NG_value <- first(group_data$NG, default = 0)
DB_value <- first(group_data$DB, default = 0) DB_value <- first(group_data$DB, default = 0)
SM_value <- first(group_data$SM, default = 0) SM_value <- first(group_data$SM, default = 0)
# Use the pre-calculated lm intercept and slope from the dataframe
lm_intercept_col <- paste0("lm_intercept_", var) lm_intercept_col <- paste0("lm_intercept_", var)
lm_slope_col <- paste0("lm_slope_", var) lm_slope_col <- paste0("lm_slope_", var)
lm_intercept_value <- first(group_data[[lm_intercept_col]], default = 0) lm_intercept_value <- first(group_data[[lm_intercept_col]], default = 0)
@@ -1037,11 +1031,14 @@ generate_interaction_plot_configs <- function(df, type) {
} }
} }
# Return plot configs # Group delta plots in chunks of 12
return(list( chunk_size <- 12
list(grid_layout = list(ncol = 2), plots = stats_plot_configs), delta_plot_chunks <- split(delta_plot_configs, ceiling(seq_along(delta_plot_configs) / chunk_size))
list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs),
list(grid_layout = list(ncol = 4), plots = delta_plot_configs[1:24]) # nrow calculated dynamically return(c(
list(list(grid_layout = list(ncol = 2), plots = stats_plot_configs)),
list(list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs)),
lapply(delta_plot_chunks, function(chunk) list(grid_layout = list(ncol = 4), plots = chunk))
)) ))
} }
@@ -1071,6 +1068,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
df = df, df = df,
x_var = rank_var, x_var = rank_var,
y_var = zscore_var, y_var = zscore_var,
x_label = "Rank",
plot_type = "scatter", plot_type = "scatter",
title = paste(y_label, "vs. Rank for", variable, "above", sd_band), title = paste(y_label, "vs. Rank for", variable, "above", sd_band),
sd_band = sd_band, sd_band = sd_band,
@@ -1090,13 +1088,13 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
# Add specific annotations for plots with annotations # Add specific annotations for plots with annotations
plot_config$annotations <- list( plot_config$annotations <- list(
list( list(
x = median(df[[rank_var]], na.rm = TRUE), x = nrow(df) / 2,
y = max(df[[zscore_var]], na.rm = TRUE) * 0.9, y = 10,
label = paste("Deletion Enhancers =", num_enhancers) label = paste("Deletion Enhancers =", num_enhancers)
), ),
list( list(
x = median(df[[rank_var]], na.rm = TRUE), x = nrow(df) / 2,
y = min(df[[zscore_var]], na.rm = TRUE) * 0.9, y = -10,
label = paste("Deletion Suppressors =", num_suppressors) label = paste("Deletion Suppressors =", num_suppressors)
) )
) )
@@ -1124,7 +1122,7 @@ generate_rank_plot_configs <- function(df, is_lm = FALSE, adjust = FALSE, overla
return(list(grid_layout = list(ncol = 3), plots = plot_configs)) return(list(grid_layout = list(ncol = 3), plots = plot_configs))
} }
generate_correlation_plot_configs <- function(df, correlation_stats) { generate_correlation_plot_configs <- function(df) {
# Define relationships for different-variable correlations # Define relationships for different-variable correlations
relationships <- list( relationships <- list(
list(x = "L", y = "K"), list(x = "L", y = "K"),
@@ -1421,7 +1419,7 @@ main <- function() {
list(out_dir = out_dir_qc, filename = "plate_analysis_boxplots", list(out_dir = out_dir_qc, filename = "plate_analysis_boxplots",
plot_configs = plate_analysis_boxplot_configs, page_width = 18, page_height = 9), plot_configs = plate_analysis_boxplot_configs, page_width = 18, page_height = 9),
list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros", list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros",
plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 12, page_height = 8), plot_configs = plate_analysis_no_zeros_plot_configs, page_width = 14, page_height = 9),
list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros_boxplots", list(out_dir = out_dir_qc, filename = "plate_analysis_no_zeros_boxplots",
plot_configs = plate_analysis_no_zeros_boxplot_configs, page_width = 18, page_height = 9), plot_configs = plate_analysis_no_zeros_boxplot_configs, page_width = 18, page_height = 9),
list(out_dir = out_dir_qc, filename = "L_vs_K_for_strains_2SD_outside_mean_K", list(out_dir = out_dir_qc, filename = "L_vs_K_for_strains_2SD_outside_mean_K",
@@ -1431,10 +1429,10 @@ main <- function() {
) )
# Parallelize background and quality control plot generation # Parallelize background and quality control plot generation
# furrr::future_map(plot_configs, function(config) { furrr::future_map(plot_configs, function(config) {
# generate_and_save_plots(config$out_dir, config$filename, config$plot_configs, generate_and_save_plots(config$out_dir, config$filename, config$plot_configs,
# page_width = config$page_width, page_height = config$page_height) page_width = config$page_width, page_height = config$page_height)
# }, .options = furrr_options(seed = TRUE)) }, .options = furrr_options(seed = TRUE))
# Loop over background strains # Loop over background strains
# TODO currently only tested against one strain, if we want to do multiple strains we'll # TODO currently only tested against one strain, if we want to do multiple strains we'll
@@ -1494,7 +1492,7 @@ main <- function() {
message("Generating reference interaction plots") message("Generating reference interaction plots")
reference_plot_configs <- generate_interaction_plot_configs(df_interactions_reference_joined, "reference") reference_plot_configs <- generate_interaction_plot_configs(df_interactions_reference_joined, "reference")
generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 18, page_height = 16) generate_and_save_plots(out_dir, "interaction_plots_reference", reference_plot_configs, page_width = 16, page_height = 16)
message("Setting missing deletion values to the highest theoretical value at each drug conc for L") message("Setting missing deletion values to the highest theoretical value at each drug conc for L")
df_deletion <- df_na_stats %>% # formerly X2 df_deletion <- df_na_stats %>% # formerly X2
@@ -1609,4 +1607,8 @@ main <- function() {
main() main()
# For future simplification of joined dataframes # For future simplification of joined dataframes
# df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats")) # df_joined <- left_join(cleaned_df, summary_stats, by = group_vars, suffix = c("_original", "_stats"))
# # Add a custom horizontal line (for rank plots)
# if (!is.null(config$hline) && config$hline) {
# plot <- plot + geom_hline(yintercept = config$hline, linetype = "dashed", color = "black")
# }