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

Fix error bars and points for interaction plots

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-02 13:07:07 -04:00
parent 5a3fcec55f
commit 211e793f00
1 changed files with 33 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -377,8 +377,17 @@ calculate_interaction_scores <- function(df, max_conc, bg_stats, group_vars, ove
Z_Shift_L, Z_Shift_K, Z_Shift_r, Z_Shift_AUC Z_Shift_L, Z_Shift_K, Z_Shift_r, Z_Shift_AUC
) )
calculations_no_overlap <- calculations %>%
# DB, NG, SM are same as in interactions, the rest may be different and need to be checked
select(-any_of(c(
"DB", "NG", "SM",
"Raw_Shift_L", "Raw_Shift_K", "Raw_Shift_r", "Raw_Shift_AUC",
"Z_Shift_L", "Z_Shift_K", "Z_Shift_r", "Z_Shift_AUC",
"Z_lm_L", "Z_lm_K", "Z_lm_r", "Z_lm_AUC"
)))
# Use left_join to avoid dimension mismatch issues # Use left_join to avoid dimension mismatch issues
full_data <- calculations %>% full_data <- calculations_no_overlap %>%
left_join(interactions, by = group_vars) left_join(interactions, by = group_vars)
# Return full_data and the two required dataframes (calculations and interactions) # Return full_data and the two required dataframes (calculations and interactions)
@@ -471,12 +480,12 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
dev.off() dev.off()
out_html_file <- file.path(out_dir, paste0(filename, ".html")) # out_html_file <- file.path(out_dir, paste0(filename, ".html"))
message("Saving combined HTML file: ", out_html_file) # message("Saving combined HTML file: ", out_html_file)
htmltools::save_html( # htmltools::save_html(
htmltools::tagList(plotly_plots), # htmltools::tagList(plotly_plots),
file = out_html_file # file = out_html_file
) # )
} }
} }
@@ -570,11 +579,23 @@ generate_scatter_plot <- function(plot, config) {
# Add error bars if specified # Add error bars if specified
if (!is.null(config$error_bar) && config$error_bar && !is.null(config$y_var)) { if (!is.null(config$error_bar) && config$error_bar && !is.null(config$y_var)) {
if (!is.null(config$error_bar_params)) { if (!is.null(config$error_bar_params)) {
plot <- plot + geom_errorbar(aes(ymin = config$error_bar_params$ymin, ymax = config$error_bar_params$ymax)) error_bar_color <- if (!is.null(config$error_bar_params$color)) {
config$error_bar_params$color
} else {
"red"
}
plot <- plot + geom_errorbar(aes(
ymin = config$error_bar_params$ymin,
ymax = config$error_bar_params$ymax,
color = error_bar_color))
} else { } else {
y_mean_col <- paste0("mean_", config$y_var) y_mean_col <- paste0("mean_", config$y_var)
y_sd_col <- paste0("sd_", config$y_var) y_sd_col <- paste0("sd_", config$y_var)
plot <- plot + geom_errorbar(aes(ymin = !!sym(y_mean_col) - !!sym(y_sd_col), ymax = !!sym(y_mean_col) + !!sym(y_sd_col))) plot <- plot + geom_errorbar(aes(
ymin = !!sym(y_mean_col) - !!sym(y_sd_col),
ymax = !!sym(y_mean_col) + !!sym(y_sd_col),
color = "red"))
} }
} }
@@ -727,8 +748,9 @@ generate_interaction_plot_configs <- function(df, type) {
plot_type = "scatter", plot_type = "scatter",
x_var = "conc_num_factor_factor", x_var = "conc_num_factor_factor",
y_var = var, y_var = var,
shape = 16,
x_label = unique(df$Drug)[1], x_label = unique(df$Drug)[1],
title = sprintf("Scatter RF for %s with SD", var), title = sprintf("%s Scatter RF for %s with SD", OrfRep, var),
coord_cartesian = y_limits, coord_cartesian = y_limits,
error_bar = TRUE, error_bar = TRUE,
x_breaks = unique(df$conc_num_factor_factor), x_breaks = unique(df$conc_num_factor_factor),
@@ -769,7 +791,7 @@ generate_interaction_plot_configs <- function(df, type) {
# Z_Shift and lm values # 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, DB, SM values
NG_value <- first(group_data$NG, default = 0) NG_value <- first(group_data$NG, default = 0)