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

Refactor interactive tooltips

Browse Source
This commit is contained in:
Bryan Roessler
2024-09-18 02:15:32 -04:00
parent d6e057b618
commit d42dd71b97
1 changed files with 54 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -370,18 +370,29 @@ generate_and_save_plots <- function(out_dir, file_name, plot_configs, grid_layou
config <- plot_configs[[i]] config <- plot_configs[[i]]
df <- config$df df <- config$df
# Build the aes_mapping based on config # Define aes_mapping based on plot type
aes_mapping <- if (is.null(config$color_var)) { if (config$plot_type == "scatter") {
if (is.null(config$y_var)) { if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
aes(x = .data[[config$x_var]]) tooltip_text <- paste("OrfRep:", df$OrfRep, "<br>Gene:", df$Gene, "<br>delta_bg:", df$delta_bg)
} else if (!is.null(config$gene_point) && config$gene_point) {
tooltip_text <- paste("OrfRep:", df$OrfRep, "<br>Gene:", df$Gene)
} else { } else {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]]) tooltip_text <- paste("x:", df[[config$x_var]], "<br>y:", df[[config$y_var]])
}
aes_mapping <- if (is.null(config$color_var)) {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]], text = tooltip_text)
} else {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]],
color = as.factor(.data[[config$color_var]]), text = tooltip_text)
} }
} else { } else {
if (is.null(config$y_var)) { # Define aes_mapping for other plot types without 'text' aesthetic
aes(x = .data[[config$x_var]], color = as.factor(.data[[config$color_var]])) aes_mapping <- if (is.null(config$color_var)) {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]])
} else { } else {
aes(x = .data[[config$x_var]], y = .data[[config$y_var]], color = as.factor(.data[[config$color_var]])) aes(x = .data[[config$x_var]], y = .data[[config$y_var]],
color = as.factor(.data[[config$color_var]]))
} }
} }
@@ -413,14 +424,16 @@ generate_and_save_plots <- function(out_dir, file_name, plot_configs, grid_layou
plot <- plot + ylab(config$y_label) plot <- plot + ylab(config$y_label)
} }
# Add interactive tooltips for plotly plots # Convert to plotly object
tooltip_vars <- c()
if (config$plot_type == "scatter") { if (config$plot_type == "scatter") {
tooltip_vars <- c(config$x_var, config$y_var) plotly_plot <- ggplotly(plot, tooltip = "text")
} else {
# For non-scatter plots, decide if tooltips are needed
# If not, you can set tooltip to NULL or specify relevant aesthetics
plotly_plot <- ggplotly(plot, tooltip = "none")
} }
# Convert to plotly object # Adjust legend position if specified
plotly_plot <- ggplotly(plot, tooltip = tooltip_vars)
if (!is.null(config$legend_position) && config$legend_position == "bottom") { if (!is.null(config$legend_position) && config$legend_position == "bottom") {
plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h")) plotly_plot <- plotly_plot %>% layout(legend = list(orientation = "h"))
} }
@@ -917,14 +930,13 @@ generate_correlation_plot_configs <- function(df) {
return(configs) return(configs)
} }
filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FALSE, filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FALSE,
rank = FALSE, limits_map = NULL, verbose = TRUE) { rank = FALSE, limits_map = NULL, verbose = TRUE) {
avg_zscore_cols <- paste0("Avg_Zscore_", variables) avg_zscore_cols <- paste0("Avg_Zscore_", variables)
z_lm_cols <- paste0("Z_lm_", variables) z_lm_cols <- paste0("Z_lm_", variables)
# Adjust NAs to .001 for linear model # Step 1: Adjust NAs to 0.001 for linear model (if adjust = TRUE)
if (adjust) { if (adjust) {
if (verbose) message("Replacing NA with 0.001 for Avg_Zscore_ and Z_lm_ columns") if (verbose) message("Replacing NA with 0.001 for Avg_Zscore_ and Z_lm_ columns")
df <- df %>% df <- df %>%
@@ -933,57 +945,30 @@ filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FAL
across(all_of(z_lm_cols), ~ ifelse(is.na(.), 0.001, .)) across(all_of(z_lm_cols), ~ ifelse(is.na(.), 0.001, .))
) )
} }
# Filter non-finite values # Filter non-finite values
if (nf) { if (nf) {
non_finite_df <- df %>%
filter(if_any(all_of(variables), ~ !is.finite(.)))
if (verbose && nrow(non_finite_df) > 0) {
message("Filtering non-finite rows for variable(s) ", paste(variables, collapse = ", "), ":")
print(non_finite_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
}
df <- df %>% df <- df %>%
filter(if_all(all_of(variables), ~ is.finite(.))) filter(if_all(all_of(variables), ~ is.finite(.)))
} }
# Filter missing values # Filter missing values
if (missing) { if (missing) {
missing_df <- df %>%
filter(if_any(all_of(variables), ~ is.na(.)))
if (verbose && nrow(missing_df) > 0) {
message("Filtering missing data for variable(s) ", paste(variables, collapse = ", "), ":")
print(missing_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
}
df <- df %>% df <- df %>%
filter(if_all(all_of(variables), ~ !is.na(.))) filter(if_all(all_of(variables), ~ !is.na(.)))
} }
# Apply Limits from 'limits_map' if provided # Apply limits from 'limits_map' if provided
if (!is.null(limits_map)) { if (!is.null(limits_map)) {
for (variable in names(limits_map)) { for (variable in names(limits_map)) {
if (variable %in% variables) { if (variable %in% variables) {
ylim_vals <- limits_map[[variable]] ylim_vals <- limits_map[[variable]]
out_of_range_df <- df %>%
filter(.data[[variable]] < ylim_vals[1] | .data[[variable]] > ylim_vals[2])
if (verbose && nrow(out_of_range_df) > 0) {
message("Applying limits for variable ", variable, ": [", ylim_vals[1], ", ", ylim_vals[2], "].")
message("Filtering out-of-range data for variable ", variable, ":")
print(out_of_range_df %>% select(all_of(c("scan", "Plate", "Row", "Col", "num", "conc_num", variables))), n = 30)
}
df <- df %>% df <- df %>%
filter(.data[[variable]] >= ylim_vals[1] & .data[[variable]] <= ylim_vals[2]) filter(.data[[variable]] >= ylim_vals[1] & .data[[variable]] <= ylim_vals[2])
} }
} }
} }
# Calculate and add rank columns # Calculate and add rank columns
if (rank) { if (rank) {
if (verbose) message("Calculating ranks for variable(s): ", paste(variables, collapse = ", ")) if (verbose) message("Calculating ranks for variable(s): ", paste(variables, collapse = ", "))
@@ -1002,6 +987,7 @@ filter_data <- function(df, variables, nf = FALSE, missing = FALSE, adjust = FAL
return(df) return(df)
} }
main <- function() { main <- function() {
lapply(names(args$experiments), function(exp_name) { lapply(names(args$experiments), function(exp_name) {
exp <- args$experiments[[exp_name]] exp <- args$experiments[[exp_name]]
@@ -1197,16 +1183,16 @@ main <- function() {
) )
) )
# message("Generating quality control plots") message("Generating quality control plots")
# generate_and_save_plots(out_dir_qc, "L_vs_K_before_quality_control", l_vs_k_plots) generate_and_save_plots(out_dir_qc, "L_vs_K_before_quality_control", l_vs_k_plots)
# generate_and_save_plots(out_dir_qc, "frequency_delta_background", frequency_delta_bg_plots) generate_and_save_plots(out_dir_qc, "frequency_delta_background", frequency_delta_bg_plots)
# generate_and_save_plots(out_dir_qc, "L_vs_K_above_threshold", above_threshold_plots) generate_and_save_plots(out_dir_qc, "L_vs_K_above_threshold", above_threshold_plots)
# generate_and_save_plots(out_dir_qc, "plate_analysis", plate_analysis_plot_configs) generate_and_save_plots(out_dir_qc, "plate_analysis", plate_analysis_plot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_boxplots", plate_analysis_boxplot_configs) generate_and_save_plots(out_dir_qc, "plate_analysis_boxplots", plate_analysis_boxplot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros", plate_analysis_no_zeros_plot_configs) generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros", plate_analysis_no_zeros_plot_configs)
# generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros_boxplots", plate_analysis_no_zeros_boxplot_configs) generate_and_save_plots(out_dir_qc, "plate_analysis_no_zeros_boxplots", plate_analysis_no_zeros_boxplot_configs)
# generate_and_save_plots(out_dir_qc, "L_vs_K_for_strains_2SD_outside_mean_K", l_outside_2sd_k_plots) generate_and_save_plots(out_dir_qc, "L_vs_K_for_strains_2SD_outside_mean_K", l_outside_2sd_k_plots)
# generate_and_save_plots(out_dir_qc, "delta_background_vs_K_for_strains_2sd_outside_mean_K", delta_bg_outside_2sd_k_plots) generate_and_save_plots(out_dir_qc, "delta_background_vs_K_for_strains_2sd_outside_mean_K", delta_bg_outside_2sd_k_plots)
# Process background strains # Process background strains
bg_strains <- c("YDL227C") bg_strains <- c("YDL227C")
@@ -1370,10 +1356,12 @@ main <- function() {
plot_configs = rank_lm_plot_configs, grid_layout = list(ncol = 3, nrow = 2)) plot_configs = rank_lm_plot_configs, grid_layout = list(ncol = 3, nrow = 2))
message("Filtering and reranking plots") message("Filtering and reranking plots")
# Formerly X_NArm # Filter out rows where both Z_lm_L and Avg_Zscore_L are NA
zscores_interactions_filtered <- zscores_interactions_joined %>% zscores_interactions_filtered <- zscores_interactions_joined %>%
group_by(across(all_of(c("OrfRep", "Gene", "num")))) %>% filter(!is.na(Z_lm_L) | !is.na(Avg_Zscore_L))
filter(!is.na(Z_lm_L) | !is.na(Avg_Zscore_L)) %>%
# Formerly X_NArm
zscores_interactions_filtered <- zscores_interactions_filtered %>%
mutate( mutate(
lm_R_squared_L = if (n() > 1) summary(lm(Z_lm_L ~ Avg_Zscore_L))$r.squared else NA, lm_R_squared_L = if (n() > 1) summary(lm(Z_lm_L ~ Avg_Zscore_L))$r.squared else NA,
lm_R_squared_K = if (n() > 1) summary(lm(Z_lm_K ~ Avg_Zscore_K))$r.squared else NA, lm_R_squared_K = if (n() > 1) summary(lm(Z_lm_K ~ Avg_Zscore_K))$r.squared else NA,
@@ -1382,8 +1370,10 @@ main <- function() {
Overlap = case_when( Overlap = case_when(
Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both", Z_lm_L >= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Both",
Z_lm_L <= -2 & Avg_Zscore_L <= -2 ~ "Deletion Suppressor Both", Z_lm_L <= -2 & Avg_Zscore_L <= -2 ~ "Deletion Suppressor Both",
Z_lm_L >= 2 & Avg_Zscore_L < 2 ~ "Deletion Enhancer lm only", Z_lm_L >= 2 & Avg_Zscore_L <= 2 ~ "Deletion Enhancer lm only",
Z_lm_L <= -2 & Avg_Zscore_L > -2 ~ "Deletion Suppressor lm only", Z_lm_L <= 2 & Avg_Zscore_L >= 2 ~ "Deletion Enhancer Avg Zscore only",
Z_lm_L <= -2 & Avg_Zscore_L >= -2 ~ "Deletion Suppressor lm only",
Z_lm_L >= -2 & Avg_Zscore_L <= -2 ~ "Deletion Suppressor Avg Zscore only",
Z_lm_L >= 2 & Avg_Zscore_L <= -2 ~ "Deletion Enhancer lm, Deletion Suppressor Avg Z score", Z_lm_L >= 2 & Avg_Zscore_L <= -2 ~ "Deletion Enhancer lm, Deletion Suppressor Avg Z score",
Z_lm_L <= -2 & Avg_Zscore_L >= 2 ~ "Deletion Suppressor lm, Deletion Enhancer Avg Z score", Z_lm_L <= -2 & Avg_Zscore_L >= 2 ~ "Deletion Suppressor lm, Deletion Enhancer Avg Z score",
TRUE ~ "No Effect" TRUE ~ "No Effect"