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

Simplify aes mappings

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-06 19:48:54 -04:00
parent bc0a7579c8
commit 214397e6ee
1 changed files with 36 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -538,28 +538,21 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
next # skip plot if insufficient data is available
}
aes_mapping <- if (config$plot_type == "bar") {
if (!is.null(config$color_var)) {
aes(x = .data[[config$x_var]], fill = .data[[config$color_var]], color = .data[[config$color_var]])
} else {
aes(x = .data[[config$x_var]])
}
} else if (config$plot_type == "density") {
if (!is.null(config$color_var)) {
aes(x = .data[[config$x_var]], color = .data[[config$color_var]])
} else {
aes(x = .data[[config$x_var]])
}
} else {
if (!is.null(config$y_var) && !is.null(config$color_var)) {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = .data[[config$color_var]])
} else if (!is.null(config$y_var)) {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
} else {
aes(x = .data[[config$x_var]])
}
# Create initial aes mappings for all plot types
aes_mapping <- aes(x = .data[[config$x_var]]) # required
if (!is.null(config$y_var)) {
aes_mapping <- modifyList(aes_mapping, aes(y = .data[[config$y_var]])) # optional for density/bar plots
}
if (!is.null(config$color_var)) {
aes_mapping <- modifyList(aes_mapping, aes(color = .data[[config$color_var]])) # dynamic color_var
} else if (!is.null(config$color)) {
aes_mapping <- modifyList(aes_mapping, aes(color = config$color)) # static color
}
if (config$plot_type == "bar" && !is.null(config$color_var)) {
aes_mapping <- modifyList(aes_mapping, aes(fill = .data[[config$color_var]])) # only fill bar plots
}
# Begin plot generation
plot <- ggplot(df, aes_mapping) + theme_publication(legend_position = config$legend_position)
plot <- switch(config$plot_type,
@@ -567,7 +560,7 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
"box" = generate_boxplot(plot, config),
"density" = plot + geom_density(),
"bar" = plot + geom_bar(),
plot # default
plot # default
)
if (!is.null(config$title)) {
@@ -798,21 +791,21 @@ generate_scatter_plot <- function(plot, config) {
)
}
# Add rectangles if specified
if (!is.null(config$rectangles)) {
for (rect in config$rectangles) {
plot <- plot + annotate(
"rect",
xmin = rect$xmin,
xmax = rect$xmax,
ymin = rect$ymin,
ymax = rect$ymax,
fill = ifelse(is.null(rect$fill), NA, rect$fill),
color = ifelse(is.null(rect$color), "black", rect$color),
alpha = ifelse(is.null(rect$alpha), 0.1, rect$alpha)
)
}
}
# # Add rectangles if specified
# if (!is.null(config$rectangles)) {
# for (rect in config$rectangles) {
# plot <- plot + annotate(
# "rect",
# xmin = rect$xmin,
# xmax = rect$xmax,
# ymin = rect$ymin,
# ymax = rect$ymax,
# fill = ifelse(is.null(rect$fill), NA, rect$fill),
# color = ifelse(is.null(rect$color), "black", rect$color),
# alpha = ifelse(is.null(rect$alpha), 0.1, rect$alpha)
# )
# }
# }
# Customize X-axis if specified
if (!is.null(config$x_breaks) && !is.null(config$x_labels) && !is.null(config$x_label)) {
@@ -1201,10 +1194,6 @@ generate_correlation_plot_configs <- function(df, df_reference) {
list(x = "r", y = "AUC")
)
# This filtering was in the original script
# df_reference <- df_reference %>%
# filter(!is.na(Z_lm_L))
plot_configs <- list()
# Iterate over the option to highlight cyan points (TRUE/FALSE)
@@ -1500,10 +1489,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
@@ -1612,9 +1601,9 @@ main <- function() {
write.csv(deletion_results$calculations, file = file.path(out_dir, "zscore_calculations.csv"), row.names = FALSE)
write.csv(df_interactions, file = file.path(out_dir, "zscore_interactions.csv"), row.names = FALSE)
message("Generating deletion interaction plots")
deletion_plot_configs <- generate_interaction_plot_configs(df_reference_summary_stats, df_interactions_joined, "deletion")
generate_and_save_plots(out_dir, "interaction_plots", deletion_plot_configs, page_width = 16, page_height = 16)
# message("Generating deletion interaction plots")
# deletion_plot_configs <- generate_interaction_plot_configs(df_reference_summary_stats, df_interactions_joined, "deletion")
# generate_and_save_plots(out_dir, "interaction_plots", deletion_plot_configs, page_width = 16, page_height = 16)
message("Writing enhancer/suppressor csv files")
interaction_threshold <- 2 # TODO add to study config?