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

Move automatic nrow calculation to generate_and_save_plots

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-04 13:56:30 -04:00
parent 962f2fffed
commit 328fe1f116
1 changed files with 91 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -513,20 +513,67 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
static_plots <- list()
plotly_plots <- list()
# Retrieve grid layout if it exists, otherwise skip
grid_layout <- group$grid_layout
plots <- group$plots
# Only handle grid layout if it exists
if (!is.null(grid_layout)) {
# Set grid_ncol to 1 if not specified
if (is.null(grid_layout$ncol)) {
grid_layout$ncol <- 1
}
# If ncol is set but nrow is not, calculate nrow dynamically based on num_plots
if (!is.null(grid_layout$ncol) && is.null(grid_layout$nrow)) {
num_plots <- length(plots)
nrow <- ceiling(num_plots / grid_layout$ncol)
message("No nrow provided, automatically using nrow = ", nrow)
grid_layout$nrow <- nrow
}
}
for (i in seq_along(plots)) {
config <- plots[[i]]
df <- config$df
# Filter points outside of y-limits if specified
if (!is.null(config$ylim_vals)) {
out_of_bounds_df <- df %>%
filter(
is.na(.data[[config$y_var]]) |
.data[[config$y_var]] < config$ylim_vals[1] |
.data[[config$y_var]] > config$ylim_vals[2]
)
# Print rows being filtered out
if (nrow(out_of_bounds_df) > 0) {
message("Filtered out rows outside y-limits:")
print(out_of_bounds_df)
}
# Filter the valid data for plotting
df <- df %>%
filter(
!is.na(.data[[config$y_var]]) &
.data[[config$y_var]] >= config$ylim_vals[1] &
.data[[config$y_var]] <= config$ylim_vals[2]
)
}
# Set up aes mapping based on plot type
aes_mapping <- if (config$plot_type == "bar" || config$plot_type == "density") {
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]])
@@ -573,63 +620,28 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
# Add error bars if specified
if (!is.null(config$error_bar) && config$error_bar) {
# Check if a fixed color is provided or if it should come from a data column
error_bar_color <- config$error_bar_params$color
if (!is.null(config$error_bar_params$ymin) && !is.null(config$error_bar_params$ymax)) {
# Check if ymin and ymax are constants or column names
if (is.numeric(config$error_bar_params$ymin) && is.numeric(config$error_bar_params$ymax)) {
plot <- plot + geom_errorbar(
aes(x = .data[[config$x_var]]),
ymin = config$error_bar_params$ymin,
ymax = config$error_bar_params$ymax
)
} else {
# Map color_var to data if available
if (!is.null(config$color_var)) {
plot <- plot + geom_errorbar(
aes(
x = .data[[config$x_var]],
ymin = .data[[config$error_bar_params$ymin]],
ymax = .data[[config$error_bar_params$ymax]],
color = .data[[config$color_var]]
)
)
} else {
plot <- plot + geom_errorbar(
aes(
x = .data[[config$x_var]],
ymin = .data[[config$error_bar_params$ymin]],
ymax = .data[[config$error_bar_params$ymax]]
)
)
}
}
} else {
# Use mean and SD columns from df
y_mean_col <- paste0("mean_", config$y_var)
y_sd_col <- paste0("sd_", config$y_var)
if (y_mean_col %in% colnames(df) && y_sd_col %in% colnames(df)) {
if (!is.null(config$color_var)) {
# If color_var is provided and no fixed error bar color is set, use aes() to map color dynamically
if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) {
plot <- plot + geom_errorbar(
aes(
x = .data[[config$x_var]],
ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
ymax = .data[[y_mean_col]] + .data[[y_sd_col]],
color = .data[[config$color_var]]
color = .data[[config$color_var]] # Dynamic color from the data
)
)
} else {
# If a fixed error bar color is set, use it outside aes
plot <- plot + geom_errorbar(
aes(
x = .data[[config$x_var]],
ymin = .data[[y_mean_col]] - .data[[y_sd_col]],
ymax = .data[[y_mean_col]] + .data[[y_sd_col]]
),
color = config$error_bar_params$color # Fixed color
)
)
}
}
}
}
@@ -869,6 +881,7 @@ generate_interaction_plot_configs <- function(df, type) {
# Common plot configuration
plot_config <- list(
df = df,
plot_type = plot_type,
x_var = "conc_num_factor_factor",
y_var = var,
shape = 16,
@@ -880,21 +893,18 @@ generate_interaction_plot_configs <- function(df, type) {
# 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_params <- list(
y_sd_prefix = "WT_sd_",
y_mean_prefix = "mean_",
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 =")
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
@@ -909,11 +919,9 @@ generate_interaction_plot_configs <- function(df, type) {
plot_config$annotations <- annotations
# Append to scatter plot configurations
stats_plot_configs <- append(stats_plot_configs, list(plot_config))
} else if (plot_type == "box") {
plot_config$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
@@ -1001,6 +1009,7 @@ generate_interaction_plot_configs <- function(df, type) {
x_breaks = unique(group_data$conc_num_factor_factor),
x_labels = as.character(unique(group_data$conc_num)),
ylim_vals = y_limits,
y_filter = FALSE,
lm_line = list(
intercept = lm_intercept_value,
slope = lm_slope_value
@@ -1010,15 +1019,10 @@ generate_interaction_plot_configs <- function(df, type) {
}
}
# Calculate dynamic grid layout
grid_ncol <- 4
num_plots <- length(delta_plot_configs)
grid_nrow <- ceiling(num_plots / grid_ncol)
return(list(
list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_plot_configs),
list(grid_layout = list(ncol = 2, nrow = 2), plots = stats_boxplot_configs),
list(grid_layout = list(ncol = 4, nrow = grid_nrow), plots = delta_plot_configs)
list(grid_layout = list(ncol = 2), plots = stats_plot_configs), # nrow will be calculated dynamically
list(grid_layout = list(ncol = 2), plots = stats_boxplot_configs), # nrow will be calculated dynamically
list(grid_layout = list(ncol = 4), plots = delta_plot_configs) # nrow will be calculated dynamically
))
}
@@ -1412,9 +1416,9 @@ main <- function() {
plot_configs = delta_bg_outside_2sd_k_plot_configs)
)
furrr::future_map(plot_configs, function(config) {
generate_and_save_plots(config$out_dir, config$filename, config$plot_configs)
}, .options = furrr_options(seed = TRUE))
# furrr::future_map(plot_configs, function(config) {
# generate_and_save_plots(config$out_dir, config$filename, config$plot_configs)
# }, .options = furrr_options(seed = TRUE))
bg_strains <- c("YDL227C")
lapply(bg_strains, function(strain) {