library(shiny)
library(teal)
library(teal.data)
library(teal.widgets)
library(teal.modules.hermes) # pak::pak("insightsengineering/teal.modules.hermes")
library(hermes)
library(SummarizedExperiment)
library(ComplexHeatmap)
library(InteractiveComplexHeatmap)teal.modules.hermes with InteractiveComplexHeatmap
This vignette combines pre-built teal.modules.hermes RNA-seq modules with a custom teal module that renders a selected hermes assay through InteractiveComplexHeatmap.
The teal.modules.hermes reference includes ready-to-use modules such as tm_g_quality(), tm_g_pca(), tm_g_boxplot(), tm_g_barplot(), tm_g_scatterplot(), and tm_g_volcanoplot(). It also exposes lower-level Shiny selector modules, including experimentSpecInput() and assaySpecInput(), which are useful for custom modules that need to select an experiment and assay from a MultiAssayExperiment.
Prerequisites
Example Data
The pre-built teal.modules.hermes modules expect a MultiAssayExperiment object that contains hermes experiments. The package ships a small example object that can be passed directly to teal_data().
teal_data_mae <- teal.data::teal_data(
MAE = hermes::multi_assay_experiment
)Built-In hermes Modules
These modules provide standard RNA-seq exploration views for the same MAE object. They can be used as a reference point beside the custom interactive heatmap module below.
hermes_builtin_app <- teal::init(
data = teal_data_mae,
modules = teal::modules(
teal.modules.hermes::tm_g_quality(label = "Quality control", mae_name = "MAE"),
teal.modules.hermes::tm_g_pca(label = "PCA", mae_name = "MAE"),
teal.modules.hermes::tm_g_boxplot(label = "Boxplot", mae_name = "MAE"),
teal.modules.hermes::tm_g_barplot(label = "Barplot", mae_name = "MAE"),
teal.modules.hermes::tm_g_scatterplot(label = "Scatterplot", mae_name = "MAE"),
teal.modules.hermes::tm_g_volcanoplot(label = "Volcano plot", mae_name = "MAE")
)
)
# shiny::shinyApp(hermes_builtin_app$ui, hermes_builtin_app$server)Interactive Heatmap Module
This custom module uses teal.modules.hermes::experimentSpecInput() and teal.modules.hermes::assaySpecInput() for the same experiment and assay selection flow as the built-in modules. The selected assay is converted to a ComplexHeatmap object and registered with InteractiveComplexHeatmap.
First, let’s re-define the helpers function from vignette ‘2_se_adsl_adae.qmd’
## Shared Helpers
as_heatmap_matrix <- function(x, id_col = c("ID", "id"), exclude_cols = "id_seq") {
if (is.matrix(x)) {
storage.mode(x) <- "numeric"
return(x)
}
if (!is.data.frame(x)) {
stop("Expected a matrix or data frame.", call. = FALSE)
}
id_col <- intersect(id_col, names(x))[1]
if (!is.na(id_col)) {
x <- tibble::column_to_rownames(x, id_col)
}
x <- x[, setdiff(names(x), exclude_cols), drop = FALSE]
numeric_cols <- vapply(x, is.numeric, logical(1))
if (!any(numeric_cols)) {
stop("The selected data must contain at least one numeric column.", call. = FALSE)
}
as.matrix(x[, numeric_cols, drop = FALSE])
}
scale_heatmap_matrix <- function(m, scale_by = c("none", "row", "column")) {
scale_by <- match.arg(scale_by)
if (scale_by == "row") {
return(t(scale(t(m))))
}
if (scale_by == "column") {
return(scale(m))
}
m
}
make_heatmap <- function(
x,
scale_by = c("none", "row", "column"),
cluster_rows = TRUE,
cluster_columns = TRUE,
palette = c("blue_white_red", "viridis"),
name = "value") {
scale_by <- match.arg(scale_by)
palette <- match.arg(palette)
m <- as_heatmap_matrix(x)
m <- scale_heatmap_matrix(m, scale_by = scale_by)
if (palette == "blue_white_red") {
col_fun <- circlize::colorRamp2(
c(min(m, na.rm = TRUE), 0, max(m, na.rm = TRUE)),
c("#2B6CB0", "#F7FAFC", "#C53030")
)
} else {
col_fun <- viridisLite::viridis(256)
}
ComplexHeatmap::Heatmap(
m,
name = name,
col = col_fun,
cluster_rows = cluster_rows,
cluster_columns = cluster_columns,
show_row_names = nrow(m) <= 50,
show_column_names = TRUE
)
}Customized module
Next write the teal modules, around these helper functions.
tm_interactive_heatmap_ui <- function(id) {
ns <- shiny::NS(id)
teal.widgets::standard_layout(
encoding = shiny::tagList(
shiny::selectInput(ns("experiment"), "Experiment", choices = NULL),
shiny::selectInput(ns("assay"), "Assay", choices = NULL),
shiny::selectInput(ns("scale_by"), "Scale", choices = c("none", "row", "column")),
shiny::selectInput(ns("palette"), "Palette", choices = c("blue_white_red", "viridis")),
shiny::checkboxInput(ns("cluster_rows"), "Cluster rows", value = TRUE),
shiny::checkboxInput(ns("cluster_columns"), "Cluster columns", value = TRUE)
),
output = InteractiveComplexHeatmap::InteractiveComplexHeatmapOutput(ns("heatmap"))
)
}
tm_interactive_heatmap_server <- function(id, data) {
shiny::moduleServer(id, function(input, output, session) {
# data() is a teal_data object; pull out the MAE
mae <- shiny::reactive({
shiny::req(data())
data()[["MAE"]]
})
# populate experiment choices from the MAE's constituent experiments
shiny::observe({
shiny::req(mae())
exp_names <- names(MultiAssayExperiment::experiments(mae()))
shiny::updateSelectInput(
session = session,
inputId = "experiment",
choices = exp_names,
selected = exp_names[2]
)
})
selected_experiment <- shiny::reactive({
shiny::req(input$experiment, mae())
MultiAssayExperiment::experiments(mae())[[input$experiment]]
})
# populate assay choices for the chosen experiment
shiny::observe({
shiny::req(selected_experiment())
assay_names <- SummarizedExperiment::assayNames(selected_experiment())
shiny::updateSelectInput(
session = session,
inputId = "assay",
choices = assay_names,
selected = assay_names[3]
)
})
selected_data <- shiny::reactive({
shiny::req(input$assay, selected_experiment())
SummarizedExperiment::assay(selected_experiment(), input$assay)
})
heatmap <- shiny::reactive({
shiny::req(selected_data())
make_heatmap(
selected_data(),
scale_by = input$scale_by,
palette = input$palette,
cluster_rows = input$cluster_rows,
cluster_columns = input$cluster_columns
)
})
shiny::observe({
shiny::req(heatmap())
InteractiveComplexHeatmap::makeInteractiveComplexHeatmap(
input = input,
output = output,
session = session,
ht_list = heatmap(),
heatmap_id = session$ns("heatmap")
)
})
})
}
tm_hermes_iheatmap <- function(label = "Interactive heatmap", mae_name = "MAE") {
module(
label = label,
ui = tm_interactive_heatmap_ui,
server = tm_interactive_heatmap_server,
#ui_args = list(mae_name = mae_name),
#server_args = list(mae_name = mae_name),
datanames = mae_name
)
}
hermes_iheatmap_app <- teal::init(
data = teal_data_mae,
modules = teal::modules(
#teal.modules.hermes::tm_g_boxplot(label = "Boxplot", mae_name = "MAE")
tm_hermes_iheatmap(label = "Interactive heatmap", mae_name = "MAE")
)
)
# shiny::shinyApp(hermes_iheatmap_app$ui, hermes_iheatmap_app$server)