Plot interaction plots in chunks of 12 for pagination
This commit is contained in:
@@ -683,7 +683,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
|
||||
ncol = grid_layout$ncol,
|
||||
nrow = grid_layout$nrow
|
||||
)
|
||||
grid.newpage()
|
||||
# grid.newpage()
|
||||
}
|
||||
}
|
||||
|
||||
@@ -919,13 +919,13 @@ generate_interaction_plot_configs <- function(df, type) {
|
||||
)
|
||||
plot_config$position <- "jitter"
|
||||
|
||||
# Cannot figure out how to place these properly for discrete x-axis so let's be hacky
|
||||
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.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(
|
||||
@@ -941,9 +941,8 @@ generate_interaction_plot_configs <- function(df, type) {
|
||||
|
||||
} else if (plot_type == "box") {
|
||||
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))
|
||||
}
|
||||
}
|
||||
@@ -982,20 +981,15 @@ generate_interaction_plot_configs <- function(df, type) {
|
||||
y_limits <- delta_limits_map[[var]]
|
||||
y_span <- y_limits[2] - y_limits[1]
|
||||
|
||||
# Error bars
|
||||
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_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)
|
||||
|
||||
# NG, DB, SM values
|
||||
NG_value <- first(group_data$NG, default = 0)
|
||||
DB_value <- first(group_data$DB, 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_slope_col <- paste0("lm_slope_", var)
|
||||
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
|
||||
return(list(
|
||||
list(grid_layout = list(ncol = 2), plots = stats_plot_configs),
|
||||
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
|
||||
# Group delta plots in chunks of 12
|
||||
chunk_size <- 12
|
||||
delta_plot_chunks <- split(delta_plot_configs, ceiling(seq_along(delta_plot_configs) / chunk_size))
|
||||
|
||||
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,
|
||||
x_var = rank_var,
|
||||
y_var = zscore_var,
|
||||
x_label = "Rank",
|
||||
plot_type = "scatter",
|
||||
title = paste(y_label, "vs. Rank for", variable, "above", 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
|
||||
plot_config$annotations <- list(
|
||||
list(
|
||||
x = median(df[[rank_var]], na.rm = TRUE),
|
||||
y = max(df[[zscore_var]], na.rm = TRUE) * 0.9,
|
||||
x = nrow(df) / 2,
|
||||
y = 10,
|
||||
label = paste("Deletion Enhancers =", num_enhancers)
|
||||
),
|
||||
list(
|
||||
x = median(df[[rank_var]], na.rm = TRUE),
|
||||
y = min(df[[zscore_var]], na.rm = TRUE) * 0.9,
|
||||
x = nrow(df) / 2,
|
||||
y = -10,
|
||||
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))
|
||||
}
|
||||
|
||||
generate_correlation_plot_configs <- function(df, correlation_stats) {
|
||||
generate_correlation_plot_configs <- function(df) {
|
||||
# Define relationships for different-variable correlations
|
||||
relationships <- list(
|
||||
list(x = "L", y = "K"),
|
||||
@@ -1421,7 +1419,7 @@ main <- function() {
|
||||
list(out_dir = out_dir_qc, filename = "plate_analysis_boxplots",
|
||||
plot_configs = plate_analysis_boxplot_configs, page_width = 18, page_height = 9),
|
||||
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",
|
||||
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",
|
||||
@@ -1431,10 +1429,10 @@ main <- function() {
|
||||
)
|
||||
|
||||
# Parallelize background and quality control plot generation
|
||||
# furrr::future_map(plot_configs, function(config) {
|
||||
# generate_and_save_plots(config$out_dir, config$filename, config$plot_configs,
|
||||
# page_width = config$page_width, page_height = config$page_height)
|
||||
# }, .options = furrr_options(seed = TRUE))
|
||||
furrr::future_map(plot_configs, function(config) {
|
||||
generate_and_save_plots(config$out_dir, config$filename, config$plot_configs,
|
||||
page_width = config$page_width, page_height = config$page_height)
|
||||
}, .options = furrr_options(seed = TRUE))
|
||||
|
||||
# Loop over background strains
|
||||
# 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")
|
||||
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")
|
||||
df_deletion <- df_na_stats %>% # formerly X2
|
||||
@@ -1609,4 +1607,8 @@ main <- function() {
|
||||
main()
|
||||
|
||||
# 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")
|
||||
# }
|
||||
Reference in New Issue
Block a user