Interactive ComplexHeatmap in Shiny and teal

Author

Dror Berel

This vignette has four focused sections:

  1. Basic InteractiveComplexHeatmap usage.
  2. A standalone Shiny app.
  3. A Shiny module wrapper.
  4. A teal module.

Sections 1 and 2 are adapted from the original tutorial, while sections 3 and 4 are new examples that demonstrate how to integrate InteractiveComplexHeatmap into a Shiny module and a teal module, respectively. Each section includes the necessary code changes and explanations to help users understand how to implement the interactive heatmap in different contexts.

Prerequisites

library(shiny)
library(dplyr)

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
library(stringr)
library(tibble)
library(tidyr)

library(teal)
Loading required package: teal.data
Loading required package: teal.code
Loading required package: teal.slice
Registered S3 method overwritten by 'teal':
  method        from      
  c.teal_slices teal.slice

You are using teal version 1.1.0

Attaching package: 'teal'
The following objects are masked from 'package:teal.slice':

    as.teal_slices, teal_slices
library(teal.widgets)

library(tidyHeatmap) # devtools::install_github("stemangiola/tidyHeatmap")
========================================
tidyHeatmap version 1.13.1
If you use tidyHeatmap in published research, please cite:
1) Mangiola et al. tidyHeatmap: an R package for modular heatmap production 
  based on tidy principles. JOSS 2020.
2) Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional 
  genomic data. Bioinformatics 2016.
This message can be suppressed by:
  suppressPackageStartupMessages(library(tidyHeatmap))
========================================

Attaching package: 'tidyHeatmap'
The following object is masked from 'package:stats':

    heatmap
library(ComplexHeatmap) # install_github("jokergoo/ComplexHeatmap")
Loading required package: grid
========================================
ComplexHeatmap version 2.26.1
Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
Github page: https://github.com/jokergoo/ComplexHeatmap
Documentation: http://jokergoo.github.io/ComplexHeatmap-reference

If you use it in published research, please cite either one:
- Gu, Z. Complex Heatmap Visualization. iMeta 2022.
- Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional 
    genomic data. Bioinformatics 2016.


The new InteractiveComplexHeatmap package can directly export static 
complex heatmaps into an interactive Shiny app with zero effort. Have a try!

This message can be suppressed by:
  suppressPackageStartupMessages(library(ComplexHeatmap))
========================================
library(InteractiveComplexHeatmap)
========================================
InteractiveComplexHeatmap version 1.9.2
Bioconductor page: http://bioconductor.org/packages/InteractiveComplexHeatmap/
Github page: https://github.com/jokergoo/InteractiveComplexHeatmap

If you use it in published research, please cite:
Gu, Z. Make Interactive Complex Heatmaps in R, 2021, Bioinformatics

This message can be suppressed by:
  suppressPackageStartupMessages(library(InteractiveComplexHeatmap))
========================================

1. Hello World: InteractiveComplexHeatmap

Start with a static heatmap, then pass the drawn object to htShiny().

m <- matrix(rnorm(100 * 100), nrow = 100)

ht <- ComplexHeatmap::Heatmap(m)
ComplexHeatmap::draw(ht)

InteractiveComplexHeatmap::htShiny(ht)

tidyHeatmap objects can be passed through as well.

mtcars_tidy <- mtcars %>%
  as_tibble(rownames = "Car name") %>%
  mutate(across(-c(`Car name`, hp, vs), scale)) %>%
  pivot_longer(
    cols = -c(`Car name`, hp, vs),
    names_to = "Property",
    values_to = "Value"
  )

mtcars_tidy_heatmap <- mtcars_tidy %>%
  heatmap(`Car name`, Property, Value)
tidyHeatmap says: (once per session) from release 1.7.0 the scaling is set to "none" by default. Please use scale = "row", "column" or "both" to apply scaling
tidyHeatmap says: If you use tidyHeatmap for scientific research, please cite: Mangiola, S. and Papenfuss, A.T., 2020. 'tidyHeatmap: an R package for modular heatmap production based on tidy principles.' Journal of Open Source Software. doi:10.21105/joss.02472.
This message is displayed once per session.
Warning: `when()` was deprecated in purrr 1.0.0.
ℹ Please use `if` instead.
ℹ The deprecated feature was likely used in the tidyHeatmap package.
  Please report the issue at
  <https://github.com/stemangiola/tidyHeatmap/issues>.
InteractiveComplexHeatmap::htShiny(mtcars_tidy_heatmap)

2. Standalone Shiny App

This step, also adapted from the InteractiveComplexHeatmap package, demonstrate a Shiny app, (without a shiny-module). Show the output in the UI and register the heatmap in the server.

basic_app_ui <- fluidPage(
  title = "InteractiveComplexHeatmap Shiny Example",
  p("A standalone Shiny app using InteractiveComplexHeatmap."),
  InteractiveComplexHeatmap::InteractiveComplexHeatmapOutput()
)

basic_app_server <- function(input, output, session) {
  InteractiveComplexHeatmap::makeInteractiveComplexHeatmap(
    input,
    output,
    session,
    ht,
    show_cell_fun = TRUE,
    show_layer_fun = TRUE
  )
}

# shinyApp(basic_app_ui, basic_app_server)

3. Shiny Module

Next, will modify the above into a Shiny module. Will do so via adding a namespace to the output id in both the UI and the server registration.

To adapt the standalone pattern into a Shiny module, the required code changes are:

  1. Wrap the UI in a module UI function and create ns <- NS(id).
  2. Replace the global output id with a namespaced id such as ns("ht_id") inside InteractiveComplexHeatmapOutput().
  3. Wrap the server logic in moduleServer() and register the heatmap from inside the module server function.
  4. Pass the same namespaced id to makeInteractiveComplexHeatmap(), typically as session$ns("ht_id"), so the output binding matches the module UI.
  5. Instantiate the module from the outer app with a concrete id such as "some_id".

Note: For simplicity, the dataset is created inside the module (server part). Later on this will be relaxed, and dataset will be passed to the {main} app independently.

module_ht_ui <- function(id) {
  ns <- NS(id)

  tagList(
    InteractiveComplexHeatmapOutput(ns("ht_id"))
  )
}

module_ht_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    m <- matrix(rnorm(100), 10)
    ht <- ComplexHeatmap::Heatmap(m)

    makeInteractiveComplexHeatmap(
      input,
      output,
      session,
      ht,
      session$ns("ht_id")
    )
  })
}

app_main_ui <- fluidPage(
  module_ht_ui("some_id")
)

app_main_server <- function(input, output, session) {
  module_ht_server("some_id")
}

# shiny::shinyApp(app_main_ui, app_main_server)

4. teal Module

The teal framework leverage a collection of Shiny modules, that are are served together under a unified meta-UI layer.
A teal module bind the UI and Server together.

This example wraps the heatmap inside a teal module and lets the user choose from the available datasets. The input dataset is converted to a numeric matrix before constructing the heatmap.

To make the module function correctly inside teal, the required code changes are:

  1. Define a module UI with teal.widgets::standard_layout() so the controls and output fit the expected teal layout.
  2. Accept the data argument in the server function because teal::module() injects datasets through that interface.
  3. Populate the dataset selector from names(data()) and react to input$dataset before building the heatmap.
  4. Convert incoming data frames to a numeric matrix before calling ComplexHeatmap::Heatmap(). In this example, the ID column is moved into row names and the remaining values are coerced with as.matrix().
  5. Pass the module through teal::module() and forward the datanames argument instead of hardcoding it, so callers can control which datasets are exposed.
  6. Build the final app with init(data = ..., modules = modules(...)), then wrap the returned ui and server in shinyApp().
heatmap_ui <- function(id) {
  ns <- NS(id)

  teal.widgets::standard_layout(
    encoding = div(
      shiny::selectInput(ns("dataset"), "Select Dataset", choices = NULL)
    ),
    output = InteractiveComplexHeatmapOutput(ns("ht_id"))
  )
}

heatmap_server <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    shiny::observe({
      shiny::updateSelectInput(session, "dataset", choices = names(data()))
    })

    data_sel <- reactive({
      req(input$dataset)
      data()[[input$dataset]]
    })

    shiny::observe({
      m <- data_sel()
      req(is.matrix(m) || is.data.frame(m))

      if (is.data.frame(m)) {
        m <- tibble::column_to_rownames(m, "ID")
        m <- as.matrix(m)
      }

      if (is.null(rownames(m))) {
        rownames(m) <- paste0("Row", seq_len(nrow(m)))
      }
      ht <- ComplexHeatmap::Heatmap(m)

      makeInteractiveComplexHeatmap(
        input = input,
        output = output,
        session = session,
        ht_list = ht,
        heatmap_id = session$ns("ht_id")
      )
    })
  })
}

tm_interactive_heatmap <- function(label = "Interactive Heatmap", datanames = "all") {
  module(
    label = label,
    ui = heatmap_ui,
    server = heatmap_server,
    datanames = datanames
  )
}

df_matrix <- matrix(rnorm(100), nrow = 10) %>%
  as.data.frame() %>%
  rename_with(~ str_replace_all(.x, "V", "Col")) %>%
  rownames_to_column("ID") %>%
  mutate(ID = paste0("Row ", ID))

teal_data_obj <- teal_data("df_matrix" = df_matrix)

teal_app <- init(
  data = teal_data_obj,
  modules = modules(
    tm_interactive_heatmap(label = "Test Heatmap")
  )
)

# shinyApp(teal_app$ui, teal_app$server)