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

Make error bar expression configurable

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-05 05:25:54 -04:00
parent 5f8f20a810
commit 274eec2814
1 changed files with 58 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -7,7 +7,6 @@ suppressMessages({
library("rlang") library("rlang")
library("ggthemes") library("ggthemes")
library("data.table") library("data.table")
library("grid")
library("gridExtra") library("gridExtra")
library("future") library("future")
library("furrr") library("furrr")
@@ -546,6 +545,15 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
message("No nrow provided, automatically using nrow = ", nrow) message("No nrow provided, automatically using nrow = ", nrow)
grid_layout$nrow <- nrow grid_layout$nrow <- nrow
} }
# Fill missing spots with nullGrob() if necessary
total_spots <- grid_layout$nrow * grid_layout$ncol
num_plots <- length(plots)
if (num_plots < total_spots) {
message("Filling ", total_spots - num_plots, " empty spots with nullGrob()")
plots <- c(plots, replicate(total_spots - num_plots, nullGrob(), simplify = FALSE))
}
} }
for (i in seq_along(plots)) { for (i in seq_along(plots)) {
@@ -653,51 +661,56 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs, page_width
paste0("sd_", config$y_var) paste0("sd_", config$y_var)
} }
# If color_var is provided and no fixed error bar color is set, use aes() to map color dynamically # Use rlang to handle custom error bar calculations
if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) { if (!is.null(config$error_bar_params$custom_error_bar)) {
custom_ymin_expr <- rlang::parse_expr(config$error_bar_params$custom_error_bar$ymin)
custom_ymax_expr <- rlang::parse_expr(config$error_bar_params$custom_error_bar$ymax)
plot <- plot + geom_errorbar( plot <- plot + geom_errorbar(
aes( aes(
x = .data[[config$x_var]], x = .data[[config$x_var]],
ymin = .data[[y_mean_col]] - .data[[y_sd_col]], ymin = !!custom_ymin_expr,
ymax = .data[[y_mean_col]] + .data[[y_sd_col]], ymax = !!custom_ymax_expr
color = .data[[config$color_var]]
),
linewidth = 0.1
)
} 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, color = config$error_bar_params$color,
linewidth = 0.1 linewidth = 0.1
) )
} else {
# If no custom error bar formula, use the default or dynamic ones
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]]
),
linewidth = 0.1
)
} else {
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,
linewidth = 0.1
)
}
} }
# Add the center point if the option is provided # Add the center point if the option is provided
if (!is.null(config$error_bar_params$mean_point) && config$error_bar_params$mean_point) { if (!is.null(config$error_bar_params$mean_point) && config$error_bar_params$mean_point) {
if (!is.null(config$color_var) && is.null(config$error_bar_params$color)) { plot <- plot + geom_point(
plot <- plot + geom_point( aes(
aes( x = .data[[config$x_var]],
x = .data[[config$x_var]], y = .data[[y_mean_col]]
y = .data[[y_mean_col]], ),
color = .data[[config$color_var]] color = config$error_bar_params$color,
), shape = 16
shape = 16 )
)
} else {
plot <- plot + geom_point(
aes(
x = .data[[config$x_var]],
y = .data[[y_mean_col]]
),
color = config$error_bar_params$color,
shape = 16
)
}
} }
} }
@@ -722,7 +735,6 @@ 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()
} }
} }
@@ -1046,7 +1058,7 @@ generate_interaction_plot_configs <- function(df_summary, df_interaction, type)
plot_config <- list( plot_config <- list(
df = group_data, df = group_data,
plot_type = "scatter", plot_type = "scatter",
x_var = "conc_num_factor_factor", x_var = "conc_num_factor_factor",
y_var = paste0("Delta_", var), y_var = paste0("Delta_", var),
x_label = paste0("[", unique(df_summary$Drug)[1], "]"), x_label = paste0("[", unique(df_summary$Drug)[1], "]"),
shape = 16, shape = 16,
@@ -1054,17 +1066,19 @@ generate_interaction_plot_configs <- function(df_summary, df_interaction, type)
title_size = rel(1.3), title_size = rel(1.3),
coord_cartesian = y_limits, coord_cartesian = y_limits,
annotations = list( annotations = list(
list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste("ZShift =", Z_Shift_value)), list(x = 1, y = y_limits[2] - 0.1 * y_span, label = paste(" ZShift =", round(Z_Shift_value, 2))),
list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste("lm ZScore =", Z_lm_value)), list(x = 1, y = y_limits[2] - 0.2 * y_span, label = paste(" lm ZScore =", round(Z_lm_value, 2))),
list(x = 1, y = y_limits[2] - 0.4 * y_span, label = paste("R-squared =", R_squared_value)), list(x = 1, y = y_limits[2] - 0.3 * y_span, label = paste(" R-squared =", round(R_squared_value, 2))),
list(x = 1, y = y_limits[1] + 0.2 * y_span, label = paste("NG =", NG_value)), list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("NG =", NG_value)),
list(x = 1, y = y_limits[1] + 0.1 * y_span, label = paste("DB =", DB_value)), list(x = 1, y = y_limits[1] + 0.05 * y_span, label = paste("DB =", DB_value)),
list(x = 1, y = y_limits[1], label = paste("SM =", SM_value)) list(x = 1, y = y_limits[1], label = paste("SM =", SM_value))
), ),
error_bar = TRUE, error_bar = TRUE,
error_bar_params = list( error_bar_params = list(
ymin = 0 - (2 * WT_sd_value), custom_error_bar = list(
ymax = 0 + (2 * WT_sd_value), ymin = paste0("0 - 2 * WT_sd_", var),
ymax = paste0("0 + 2 * WT_sd_", var)
),
color = "gray" color = "gray"
), ),
x_breaks = unique(group_data$conc_num_factor_factor), x_breaks = unique(group_data$conc_num_factor_factor),
@@ -1680,10 +1694,3 @@ main <- function() {
}) })
} }
main() main()
# For future simplification of joined dataframes
# 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")
# }