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

Use tooltips rather than text aes for interactive plotly

Browse Source
This commit is contained in:
Bryan Roessler
2024-09-15 12:28:52 -04:00
parent 4f0c36fd66
commit ee986fbd60
1 changed files with 52 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -393,65 +393,69 @@ generate_and_save_plots <- function(output_dir, file_name, plot_configs, grid_la
# Start building the plot with aes_mapping # Start building the plot with aes_mapping
plot_base <- ggplot(df, aes_mapping) plot_base <- ggplot(df, aes_mapping)
# Function to generate the plot # Use appropriate helper function based on plot type
generate_plot <- function(interactive) { plot <- switch(config$plot_type,
# Use appropriate helper function based on plot type "scatter" = generate_scatter_plot(plot_base, config),
plot <- switch(config$plot_type, "box" = generate_box_plot(plot_base, config),
"scatter" = generate_scatter_plot(plot_base, config, is_interactive = interactive), "density" = plot_base + geom_density(),
"box" = generate_box_plot(plot_base, config), "bar" = plot_base + geom_bar(),
"density" = plot_base + geom_density(), plot_base # default case if no type matches
"bar" = plot_base + geom_bar(), )
plot_base # default case if no type matches
)
# Apply additional settings if provided # Apply additional settings if provided
if (!is.null(config$legend_position)) { if (!is.null(config$legend_position)) {
plot <- plot + theme(legend.position = config$legend_position) plot <- plot + theme(legend.position = config$legend_position)
}
# Add title and labels if provided
if (!is.null(config$title)) {
plot <- plot + ggtitle(config$title)
}
if (!is.null(config$x_label)) {
plot <- plot + xlab(config$x_label)
}
if (!is.null(config$y_label)) {
plot <- plot + ylab(config$y_label)
}
# Return the plot
plot
} }
# Generate the static plot # Add title and labels if provided
static_plot <- generate_plot(interactive = FALSE) if (!is.null(config$title)) {
plot <- plot + ggtitle(config$title)
}
if (!is.null(config$x_label)) {
plot <- plot + xlab(config$x_label)
}
if (!is.null(config$y_label)) {
plot <- plot + ylab(config$y_label)
}
# Generate the interactive plot # Add interactive tooltips for plotly plots
interactive_plot <- generate_plot(interactive = TRUE) tooltip_vars <- c("x", "y") # default tooltip variables
if (!is.null(config$tooltip_vars)) {
tooltip_vars <- config$tooltip_vars
} else {
# Include default variables based on config
if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
tooltip_vars <- c(tooltip_vars, "OrfRep", "Gene", "delta_bg")
} else if (!is.null(config$gene_point) && config$gene_point) {
tooltip_vars <- c(tooltip_vars, "OrfRep", "Gene")
} else {
# Include x and y variables by default
tooltip_vars <- c("x", "y")
}
}
# Convert to plotly object # Convert to plotly object
plotly_plot <- ggplotly(interactive_plot, tooltip = "text") 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"))
} }
# Add plots to lists # Add plots to lists
static_plots[[i]] <- static_plot static_plots[[i]] <- plot
plotly_plots[[i]] <- plotly_plot plotly_plots[[i]] <- plotly_plot
} }
# PDF saving logic # Save static PDF plots
pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9) pdf(file.path(output_dir, paste0(file_name, ".pdf")), width = 14, height = 9)
lapply(static_plots, print) lapply(static_plots, print)
dev.off() dev.off()
# Combine and save interactive plots # Combine and save interactive HTML plots
combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plotly_plots), margin = 0.05) combined_plot <- subplot(plotly_plots, nrows = grid_layout$nrow %||% length(plotly_plots), margin = 0.05)
saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE) saveWidget(combined_plot, file = file.path(output_dir, paste0(file_name, ".html")), selfcontained = TRUE)
} }
generate_scatter_plot <- function(plot, config, is_interactive = FALSE) { generate_scatter_plot <- function(plot, config) {
# Check for missing or out-of-range data # Check for missing or out-of-range data
missing_data <- config$df %>% missing_data <- config$df %>%
filter( filter(
@@ -479,33 +483,20 @@ generate_scatter_plot <- function(plot, config, is_interactive = FALSE) {
) )
} }
# Add the interactive text aesthetic if `is_interactive` is TRUE if (!is.null(config$delta_bg_point) && config$delta_bg_point) {
if (is_interactive) { plot <- plot + geom_point(
if (!is.null(config$delta_bg_point) && config$delta_bg_point) { shape = config$shape %||% 3,
plot <- plot + geom_point( size = config$size %||% 0.2
aes(text = paste("ORF:", OrfRep, "Gene:", Gene, "delta_bg:", delta_bg)), )
shape = config$shape %||% 3, } else if (!is.null(config$gene_point) && config$gene_point) {
size = config$size %||% 0.2
)
} else if (!is.null(config$gene_point) && config$gene_point) {
plot <- plot + geom_point(
aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
shape = config$shape %||% 3,
size = config$size %||% 0.2,
position = "jitter"
)
} else {
plot <- plot + geom_point(
aes(text = paste("ORF:", OrfRep, "Gene:", Gene)),
shape = config$shape %||% 3,
size = config$size %||% 0.2
)
}
} else {
# For non-interactive plots, just add `geom_point` without `text` aesthetic
plot <- plot + geom_point( plot <- plot + geom_point(
shape = config$shape %||% 3, shape = config$shape %||% 3,
size = config$size %||% 0.2, size = config$size %||% 0.2,
position = "jitter"
)
} else {
plot <- plot + geom_point(
shape = config$shape %||% 3,
position = if (!is.null(config$position) && config$position == "jitter") "jitter" else "identity" position = if (!is.null(config$position) && config$position == "jitter") "jitter" else "identity"
) )
} }