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

Use htmltools to combine html widgets into single file

Browse Source
This commit is contained in:
Bryan Roessler
2024-10-01 15:24:25 -04:00
parent 8d398464e8
commit e2479de3d7
1 changed files with 69 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -406,14 +406,6 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
config <- plot_configs$plots[[i]] config <- plot_configs$plots[[i]]
df <- config$df df <- config$df
message("Processing plot ", i, ": ", config$title)
message("Plot type: ", config$plot_type)
if (is.null(df)) {
message("Dataframe for plot ", i, " is NULL.")
next
}
# Define aes_mapping, ensuring y_var is only used when it's not NULL # Define aes_mapping, ensuring y_var is only used when it's not NULL
aes_mapping <- switch(config$plot_type, aes_mapping <- switch(config$plot_type,
"bar" = if (!is.null(config$color_var)) { "bar" = if (!is.null(config$color_var)) {
@@ -490,14 +482,16 @@ generate_and_save_plots <- function(out_dir, filename, plot_configs) {
dev.off() dev.off()
# Save individual interactive HTML plots # Save combined HTML plot
for (i in seq_along(plotly_plots)) { out_html_file <- file.path(out_dir, paste0(filename, ".html"))
html_file <- file.path(out_dir, paste0(filename, "_plot_", i, ".html")) message("Saving combined HTML file: ", out_html_file)
message("Saving HTML plot ", i, ": ", html_file) htmltools::save_html(
htmlwidgets::saveWidget(plotly_plots[[i]], file = html_file, selfcontained = TRUE) htmltools::tagList(plotly_plots),
} file = out_html_file
)
} }
generate_scatter_plot <- function(plot, config) { generate_scatter_plot <- function(plot, config) {
# Define the points # Define the points
@@ -804,71 +798,30 @@ generate_interaction_plot_configs <- function(df, limits_map = NULL, plot_type =
generate_rank_plot_configs <- function(df, variables, is_lm = FALSE, adjust = FALSE, overlap_color = FALSE) { generate_rank_plot_configs <- function(df, variables, is_lm = FALSE, adjust = FALSE, overlap_color = FALSE) {
sd_bands <- c(1, 2, 3) sd_bands <- c(1, 2, 3)
avg_zscore_cols <- paste0("Avg_Zscore_", variables)
z_lm_cols <- paste0("Z_lm_", variables)
configs <- list() configs <- list()
# Adjust values if necessary # Adjust (if necessary) and rank columns
for (variable in variables) {
if (adjust) { if (adjust) {
df <- df %>% df[[paste0("Avg_Zscore_", variable)]] <- ifelse(is.na(df[[paste0("Avg_Zscore_", variable)]]), 0.001, df[[paste0("Avg_Zscore_", variable)]])
mutate(across(all_of(avg_zscore_cols), ~ ifelse(is.na(.), 0.001, .))) %>% df[[paste0("Z_lm_", variable)]] <- ifelse(is.na(df[[paste0("Z_lm_", variable)]]), 0.001, df[[paste0("Z_lm_", variable)]])
mutate(across(all_of(z_lm_cols), ~ ifelse(is.na(.), 0.001, .))) }
df[[paste0("Rank_", variable)]] <- rank(df[[paste0("Avg_Zscore_", variable)]], na.last = "keep")
df[[paste0("Rank_lm_", variable)]] <- rank(df[[paste0("Z_lm_", variable)]], na.last = "keep")
} }
# Calculate rank columns for Avg_Zscore and Z_lm columns # Helper function to create a plot configuration
df_ranked <- df %>% create_plot_config <- function(variable, rank_var, zscore_var, y_label, sd_band, with_annotations = TRUE) {
mutate(across(all_of(avg_zscore_cols), rank, .names = "Rank_{col}")) %>% num_enhancers <- sum(df[[zscore_var]] >= sd_band, na.rm = TRUE)
mutate(across(all_of(z_lm_cols), rank, .names = "Rank_lm_{col}")) num_suppressors <- sum(df[[zscore_var]] <= -sd_band, na.rm = TRUE)
# Generate plots for SD-based L and K variables # Default plot config
for (variable in c("L", "K")) { plot_config <- list(
rank_var <- if (is_lm) paste0("Rank_lm_", variable) else paste0("Rank_", variable) df = df,
zscore_var <- if (is_lm) paste0("Z_lm_", variable) else paste0("Avg_Zscore_", variable)
y_label <- if (is_lm) paste("Int Z score", variable) else paste("Avg Z score", variable)
for (sd_band in sd_bands) {
num_enhancers <- sum(df_ranked[[zscore_var]] >= sd_band, na.rm = TRUE)
num_suppressors <- sum(df_ranked[[zscore_var]] <= -sd_band, na.rm = TRUE)
# Plot with annotations
configs[[length(configs) + 1]] <- list(
df = df_ranked,
x_var = rank_var, x_var = rank_var,
y_var = zscore_var, y_var = zscore_var,
plot_type = "scatter", plot_type = "scatter",
title = paste(y_label, "vs. Rank for", variable, "above", sd_band, "SD"), title = paste(y_label, "vs. Rank for", variable, "above", sd_band),
sd_band = sd_band,
fill_positive = "#542788",
fill_negative = "orange",
alpha_positive = 0.3,
alpha_negative = 0.3,
annotations = list(
list(
x = median(df_ranked[[rank_var]], na.rm = TRUE),
y = max(df_ranked[[zscore_var]], na.rm = TRUE) * 0.9,
label = paste("Deletion Enhancers =", num_enhancers)
),
list(
x = median(df_ranked[[rank_var]], na.rm = TRUE),
y = min(df_ranked[[zscore_var]], na.rm = TRUE) * 0.9,
label = paste("Deletion Suppressors =", num_suppressors)
)
),
shape = 3,
size = 0.1,
y_label = y_label,
x_label = "Rank",
legend_position = "none"
)
# Plot without annotations
configs[[length(configs) + 1]] <- list(
df = df_ranked,
x_var = rank_var,
y_var = zscore_var,
plot_type = "scatter",
title = paste(y_label, "vs. Rank for", variable, "above", sd_band, "SD No Annotations"),
sd_band = sd_band, sd_band = sd_band,
fill_positive = "#542788", fill_positive = "#542788",
fill_negative = "orange", fill_negative = "orange",
@@ -881,59 +834,39 @@ generate_rank_plot_configs <- function(df, variables, is_lm = FALSE, adjust = FA
x_label = "Rank", x_label = "Rank",
legend_position = "none" legend_position = "none"
) )
}
}
# Generate Avg ZScore and Rank Avg ZScore plots for each variable if (with_annotations) {
for (variable in variables) { # Add specific annotations for plots with annotations
for (plot_type in c("Avg Zscore vs lm", "Rank Avg Zscore vs lm")) { plot_config$annotations <- list(
title <- paste(plot_type, variable)
# Define specific variables based on plot type
x_var <- if (plot_type == "Avg Zscore vs lm") paste0("Avg_Zscore_", variable) else paste0("Rank_", variable)
y_var <- if (plot_type == "Avg Zscore vs lm") paste0("Z_lm_", variable) else paste0("Rank_lm_", variable)
# Fit the linear model
lm_model <- lm(as.formula(paste(y_var, "~", x_var)), data = df_ranked)
intercept <- coef(lm_model)[1]
slope <- coef(lm_model)[2]
r_squared <- summary(lm_model)$r.squared
annotations <- list(
list( list(
x = mean(range(df_ranked[[x_var]], na.rm = TRUE)), x = median(df[[rank_var]], na.rm = TRUE),
y = mean(range(df_ranked[[y_var]], na.rm = TRUE)), y = max(df[[zscore_var]], na.rm = TRUE) * 0.9,
label = paste("R-squared =", round(r_squared, 2)), label = paste("Deletion Enhancers =", num_enhancers)
hjust = 0.5, ),
vjust = 1, list(
size = 5 x = median(df[[rank_var]], na.rm = TRUE),
y = min(df[[zscore_var]], na.rm = TRUE) * 0.9,
label = paste("Deletion Suppressors =", num_suppressors)
) )
) )
rectangles <- if (plot_type == "Avg Zscore vs lm") {
list(list(xmin = -2, xmax = 2, ymin = -2, ymax = 2, fill = NA, color = "grey20", alpha = 0.1))
} else {
NULL
} }
configs[[length(configs) + 1]] <- list( return(plot_config)
df = df_ranked, }
x_var = x_var,
y_var = y_var, # Generate plots for each variable
plot_type = "scatter", for (variable in variables) {
title = title, rank_var <- if (is_lm) paste0("Rank_lm_", variable) else paste0("Rank_", variable)
annotations = annotations, zscore_var <- if (is_lm) paste0("Z_lm_", variable) else paste0("Avg_Zscore_", variable)
shape = 3, y_label <- if (is_lm) paste("Int Z score", variable) else paste("Avg Z score", variable)
size = 0.25,
smooth = TRUE, # Loop through SD bands
smooth_color = "black", for (sd_band in sd_bands) {
lm_line = list(intercept = intercept, slope = slope), # Create plot with annotations
legend_position = "right", configs[[length(configs) + 1]] <- create_plot_config(variable, rank_var, zscore_var, y_label, sd_band, with_annotations = TRUE)
color_var = if (overlap_color) "Overlap" else NULL,
x_label = x_var, # Create plot without annotations
y_label = y_var, configs[[length(configs) + 1]] <- create_plot_config(variable, rank_var, zscore_var, y_label, sd_band, with_annotations = FALSE)
rectangles = rectangles
)
} }
} }