## ---- echo = FALSE------------------------------------------------------------ library(knitr) knitr::opts_chunk$set( error = FALSE, tidy = FALSE, message = FALSE, warning = FALSE, fig.align = "center" ) ## ---- eval = FALSE------------------------------------------------------------ # library(ComplexHeatmap) # library(InteractiveComplexHeatmap) # library(shiny) # # data(rand_mat) # simply a random matrix # ht1 = Heatmap(rand_mat, name = "mat", # show_row_names = FALSE, show_column_names = FALSE) # ht1 = draw(ht1) # # ui = fluidPage( # h3("My first interactive ComplexHeatmap Shiny app"), # p("This is an interactive heatmap visualization on a random matrix."), # InteractiveComplexHeatmapOutput() # ) # # server = function(input, output, session) { # makeInteractiveComplexHeatmap(input, output, session, ht1) # } # # shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # mat2 = matrix(sample(letters[1:10], 100, replace = TRUE), 10) # ht2 = draw(Heatmap(mat2, name = "mat2")) # # ui = fluidPage( # h3("The first heatmap"), # InteractiveComplexHeatmapOutput("heatmap_1"), # hr(), # h3("The second heatmap"), # InteractiveComplexHeatmapOutput("heatmap_2") # ) # server = function(input, output, session) { # makeInteractiveComplexHeatmap(input, output, session, ht1, "heatmap_1") # makeInteractiveComplexHeatmap(input, output, session, ht2, "heatmap_2") # } # shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = tabsetPanel( # tabPanel("Numeric", InteractiveComplexHeatmapOutput("heatmap_1")), # tabPanel("character", InteractiveComplexHeatmapOutput("heatmap_2")) # ) # server = function(input, output, session) { # makeInteractiveComplexHeatmap(input, output, session, ht1, "heatmap_1") # makeInteractiveComplexHeatmap(input, output, session, ht2, "heatmap_2") # } # shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # body = dashboardBody( # fluidRow( # box( # title = "Original heatmap", width = 4, solidHeader = TRUE, status = "primary", # originalHeatmapOutput("ht", title = NULL) # ), # box( # title = "Sub-heatmap", width = 4, solidHeader = TRUE, status = "primary", # subHeatmapOutput("ht", title = NULL) # ), # box( # title = "Output", width = 4, solidHeader = TRUE, status = "primary", # HeatmapInfoOutput("ht", title = NULL) # ) # ) # ) # # ui = dashboardPage( # dashboardHeader(), # dashboardSidebar(), # body # ) # # server = function(input, output, session) { # makeInteractiveComplexHeatmap(input, output, session, ht, "ht") # } # # shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # InteractiveComplexHeatmapOutput(output_ui = htmlOutput("info")) # ) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # InteractiveComplexHeatmapOutput(), # htmlOutput("info") # ) ## ---- eval = FALSE------------------------------------------------------------ # function(df, output) { # output[["info"]] = renderUI({ # or output$info = ... # if(is.null(df)) { # have not clicked or brushed into the heatmap body # ... # } else { # ... # } # }) # } ## ---- eval = FALSE------------------------------------------------------------ # unique(unlist(df$row_index)) # unique(unlist(df$column_index)) ## ---- eval = FALSE------------------------------------------------------------ # function(df, input, output, session) { # output[["info"]] = renderUI({ # or output$info = ... # if(is.null(df)) { # have not clicked into the heatmap body # ... # } else { # ... # } # }) # } ## ---- eval = FALSE------------------------------------------------------------ # library(GetoptLong) # for the qq() function which does variable intepolation # data(rand_mat) # ht = Heatmap(rand_mat, show_row_names = FALSE, show_column_names = FALSE) # ht = draw(ht) # # ui = fluidPage( # InteractiveComplexHeatmapOutput(output_ui = htmlOutput("info")), # ) # # click_action = function(df, output) { # output[["info"]] = renderUI({ # if(!is.null(df)) { # HTML(qq("

You have clicked on heatmap @{df$heatmap}, row @{df$row_index}, column @{df$column_index}

")) # } # }) # } # # suppressPackageStartupMessages(library(kableExtra)) # brush_action = function(df, output) { # row_index = unique(unlist(df$row_index)) # column_index = unique(unlist(df$column_index)) # output[["info"]] = renderUI({ # if(!is.null(df)) { # HTML(kable_styling(kbl(m[row_index, column_index, drop = FALSE], digits = 2, format = "html"), full_width = FALSE, position = "left")) # } # }) # } # # server = function(input, output, session) { # makeInteractiveComplexHeatmap(input, output, session, ht, # click_action = click_action, brush_action = brush_action) # } # # shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # InteractiveComplexHeatmapOutput(..., compact = TRUE) ## ---- eval = FALSE------------------------------------------------------------ # InteractiveComplexHeatmap(..., response = c(action, "brush-output"), output_ui_float = TRUE) ## ---- eval = FALSE------------------------------------------------------------ # new_output_ui = ... # InteractiveComplexHeatmap(..., compact = TRUE, output_ui = new_output_ui) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # sliderInput("column", label = "Which column to order?", # value = 1, min = 1, max = 10), # InteractiveComplexHeatmapOutput() # ) # # server = function(input, output, session) { # m = matrix(rnorm(100), 10) # rownames(m) = 1:10 # colnames(m) = 1:10 # # observeEvent(input$column, { # order = order(m[, input$column]) # ht = Heatmap(m[order, , drop = FALSE], # cluster_rows = FALSE, cluster_columns = FALSE) # makeInteractiveComplexHeatmap(input, output, session, ht) # }) # } # shiny::shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ... # observeEvent(input$column, { # order = order(m[, input$column]) # ht = Heatmap(m[order, , drop = FALSE], # cluster_rows = FALSE, cluster_columns = FALSE) # makeInteractiveComplexHeatmap(input, output, session, ht) # }) # ... ## ---- eval = FALSE------------------------------------------------------------ # click_action = function(df, input, output, session) { # obs = observeEvent(input$foo, { # ... # }) # record_observation(obs) # } ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # actionButton("show_heatmap", "Generate_heatmap"), # ) # # server = function(input, output, session) { # m = matrix(rnorm(100), 10) # ht = Heatmap(m) # # observeEvent(input$show_heatmap, { # InteractiveComplexHeatmapModal(input, output, session, ht) # }) # } # shiny::shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # radioButtons("select", "Select", c("Numeric" = 1, "Character" = 2)), # actionButton("show_heatmap", "Generate_heatmap"), # ) # # get_heatmap_fun = function(i) { # mat_list = list( # matrix(rnorm(100), 10), # matrix(sample(letters[1:10], 100, replace = TRUE), 10) # ) # Heatmap(mat_list[[i]]) # } # # server = function(input, output, session) { # observeEvent(input$show_heatmap, { # i = as.numeric(input$select) # InteractiveComplexHeatmapModal(input, output, session, # get_heatmap = get_heatmap_fun(i)) # }) # } # shiny::shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # actionButton("show_heatmap", "Generate_heatmap"), # htmlOutput("heatmap_output") # ) # # server = function(input, output, session) { # m = matrix(rnorm(100), 10) # ht = Heatmap(m) # # observeEvent(input$show_heatmap, { # InteractiveComplexHeatmapWidget(input, output, session, ht, output_id = "heatmap_output") # }) # } # shiny::shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # actionButton("show_heatmap", "Generate_heatmap"), # htmlOutput("heatmap_output") # ) # # server = function(input, output, session) { # m = matrix(rnorm(100), 10) # ht = Heatmap(m) # # observeEvent(input$show_heatmap1, { # InteractiveComplexHeatmapWidget(input, output, session, ht, # output_id = "heatmap_output", close_button = FALSE, # # js_code = " # $('#show_heatmap').click(function() { # $('#heatmap_output').toggle('slow'); # }).text('Show/hide heatmap'). # attr('id', 'show_heatmap_toggle'); # " # ) # }) # } # shiny::shinyApp(ui, server) ## ---- eval = FALSE------------------------------------------------------------ # ui = fluidPage( # actionButton("action", "Generate heatmap"), # plotOutput("heatmap", width = 500, height = 500, click = "heatmap_click", # brush = "heatmap_brush"), # verbatimTextOutput("output") # ) # server = function(input, output, session) { # # ht_obj = reactiveVal(NULL) # ht_pos_obj = reactiveVal(NULL) # # observeEvent(input$action, { # m = matrix(rnorm(100), 10) # rownames(m) = 1:10 # colnames(m) = 1:10 # # output$heatmap = renderPlot({ # ht = draw(Heatmap(m)) # ht_pos = htPositionsOnDevice(ht) # # ht_obj(ht) # ht_pos_obj(ht_pos) # }) # }) # # observeEvent(input$heatmap_click, { # pos = getPositionFromClick(input$heatmap_click) # # selection = selectPosition(ht_obj(), pos, mark = FALSE, ht_pos = ht_pos_obj(), # verbose = FALSE) # output$output = renderPrint({ # print(selection) # }) # }) # # observeEvent(input$heatmap_brush, { # lt = getPositionFromBrush(input$heatmap_brush) # # selection = selectArea(ht_obj(), lt[[1]], lt[[2]], mark = FALSE, ht_pos = ht_pos_obj(), # verbose = FALSE) # output$output = renderPrint({ # print(selection) # }) # }) # } # shinyApp(ui, server)