interactive.R
In ComplexHeatmap: Make Complex Heatmaps

## ---- echo = FALSE------------------------------------------------------------
library(knitr)
knitr::opts_chunk$set(
    error = FALSE,
    tidy  = FALSE,
    message = FALSE,
    warning = FALSE,
    fig.align = "center"
)

## -----------------------------------------------------------------------------
library(ComplexHeatmap)
set.seed(123)
mat1 = matrix(rnorm(100), 10)
rownames(mat1) = colnames(mat1) = paste0("a", 1:10)
mat2 = matrix(sample(letters[1:10], 100, replace = TRUE), 10)
rownames(mat2) = colnames(mat2) = paste0("b", 1:10)

ht_list = Heatmap(mat1, name = "mat_a", row_km = 2, column_km = 2) +
    Heatmap(mat2, name = "mat_b")

## ---- fig.width = 6, fig.height = 4-------------------------------------------
ht_list = draw(ht_list)
pos = ht_pos_on_device(ht_list)

## -----------------------------------------------------------------------------
pos

## ---- fig.width = 6, fig.height = 4-------------------------------------------
# If you try the code in your interactive R session, you need the following 
# two lines to open a new device with the same size as the current one.
# ds = dev.size()
# dev.new(width = ds[1], height = ds[2])
grid.newpage()
grid.rect(gp = gpar(lty = 2))
for(i in seq_len(nrow(pos))) {
	x_min = pos[i, "x_min"]
	x_max = pos[i, "x_max"]
	y_min = pos[i, "y_min"]
	y_max = pos[i, "y_max"]
	pushViewport(viewport(x = x_min, y = y_min, name = pos[i, "slice"],
		width = x_max - x_min, height = y_max - y_min,
		just = c("left", "bottom")))
	grid.rect()
	upViewport()
}

## ---- echo = FALSE, fig.width = 6, fig.height = 4-----------------------------
grid.newpage()
grid.rect(gp = gpar(lty = 2))
for(i in seq_len(nrow(pos))) {
	x_min = pos[i, "x_min"]
	x_max = pos[i, "x_max"]
	y_min = pos[i, "y_min"]
	y_max = pos[i, "y_max"]
	pushViewport(viewport(x = x_min, y = y_min, name = pos[i, "slice"],
		width = x_max - x_min, height = y_max - y_min,
		just = c("left", "bottom")))
	grid.rect()
	upViewport()
}
seekViewport("mat_a_heatmap_body_1_2")
ht = ht_list@ht_list[["mat_a"]]
m = ht@matrix

i = 1
j = 2
row_order = ht@row_order_list[[i]]
column_order = ht@column_order_list[[j]]
nr = length(row_order)
nc = length(column_order)
grid.segments(1:nc/nc, rep(0, nc), 1:nc/nc, rep(1, nc), default.units = "npc",
	gp = gpar(col = "#888888", lty = 2))
grid.segments(rep(0, nr), 1:nr/nr, rep(1, nr), 1:nr/nr, default.units = "npc",
	gp = gpar(col = "#888888", lty = 2))
grid.rect(gp = gpar(fill = NA))

grid.points(0.3, 0.8, pch = 16, size = unit(2, "mm"), gp = gpar(col = "blue"))
ComplexHeatmap:::grid.text(gt_render("(a, b)", box_gp = gpar(fill = "white", col = NA)), 
	x = unit(0.3, "npc") + unit(2, "mm"), y = unit(0.8, "npc"),
	just = "left")

grid.points(0, 0, pch = 16, size = unit(2, "mm"), gp = gpar(col = "red"))
ComplexHeatmap:::grid.text(gt_render("(x<sub>1</sub>, y<sub>1</sub>)", box_gp = gpar(fill = "white", col = NA)), 
	x = unit(0, "npc") + unit(2, "mm"), y = unit(0, "npc"),
	just = "left")
grid.points(1, 1, pch = 16, size = unit(2, "mm"), gp = gpar(col = "red"))
ComplexHeatmap:::grid.text(gt_render("(x<sub>2</sub>, y<sub>2</sub>)", box_gp = gpar(fill = "white", col = NA)), 
	x = unit(1, "npc"), y = unit(1, "npc") - unit(2, "mm"),
	just = "top")

ComplexHeatmap:::grid.text(gt_render("n<sub>r</sub> = 8", box_gp = gpar(fill = "white", col = NA)), 
	x = unit(1, "npc") + unit(1, "mm"), y = unit(0.5, "npc"),
	just = "left")

ComplexHeatmap:::grid.text(gt_render("n<sub>c</sub> = 5", box_gp = gpar(fill = "white", col = NA)), 
	x = unit(0.5, "npc"), y = unit(1, "npc") + unit(1, "mm"),
	just = "bottom")

## ---- eval = FALSE------------------------------------------------------------
#  df[1, "row_index"][[1]]
#  unlist(df[1, "row_index"])
#  df$row_index[[1]]

## ---- fig.width = 6, fig.height = 4-------------------------------------------
# pdf(...) or png(...) or other graphics devices
ht_list = draw(ht_list)
pos = selectPosition(ht_list, pos = unit(c(3, 3), "cm"))
pos
# remember to dev.off()

## ---- fig.width = 6, fig.height = 4-------------------------------------------
# pdf(...) or png(...) or other graphics devices
ht_list = draw(ht_list)
pos = selectArea(ht_list, pos1 = unit(c(3, 3), "cm"), pos2 = unit(c(5, 5), "cm"))
pos
# remember to dev.off()

## ---- eval = FALSE------------------------------------------------------------
#  ht_shiny(ht_list)

## ---- eval = FALSE------------------------------------------------------------
#  ht_list = Heatmap(mat1, name = "mat_a", row_km = 2, column_km = 2) %v%
#      Heatmap(mat2, name = "mat_b")
#  ht_shiny(ht_list)

## ---- eval = FALSE------------------------------------------------------------
#  ht = densityHeatmap(mat1)
#  ht_shiny(ht)

## ---- eval = FALSE------------------------------------------------------------
#  library(EnrichedHeatmap)
#  load(system.file("extdata", "chr21_test_data.RData", package = "EnrichedHeatmap"))
#  mat_meth = normalizeToMatrix(meth, cgi, value_column = "meth",
#  	mean_mode = "absolute", extend = 5000, w = 50, smooth = TRUE)
#  ht = EnrichedHeatmap(mat_meth, name = "methylation",
#  	column_title = "methylation near CGI")
#  ht_shiny(ht)

## ---- eval = FALSE------------------------------------------------------------
#  ht = pheatmap(mat1)
#  ht_shiny(ht)

## ---- eval = FALSE------------------------------------------------------------
#  # you can copy the following code and paste into your R session, the app runs.
#  library(shiny)
#  library(glue)
#  library(ComplexHeatmap)
#  
#  set.seed(123)
#  mat = matrix(rnorm(100), 10)
#  rownames(mat) = colnames(mat) = paste0("a", 1:10)
#  
#  ht = Heatmap(mat, name = "mat")
#  
#  ui = fluidPage(
#      fluidRow(
#          column(width = 3,
#              plotOutput("main_heatmap", height = 300, width = 300,
#                  brush = "ht_brush", click = "ht_click")
#          ),
#          column(width = 3,
#            plotOutput("sub_heatmap", height = 300, width = 300)
#          )
#      ),
#      verbatimTextOutput("ht_click_content")
#  )
#  
#  shiny_env = new.env()
#  server = function(input, output) {
#      output$main_heatmap = renderPlot({
#          shiny_env$ht = draw(ht)
#          shiny_env$ht_pos = ht_pos_on_device(shiny_env$ht)
#      })
#  
#      output$sub_heatmap = renderPlot({
#          if(is.null(input$ht_brush)) {
#              grid.newpage()
#              grid.text("No region is selected.", 0.5, 0.5)
#          } else {
#              lt = ComplexHeatmap:::get_pos_from_brush(input$ht_brush)
#              pos1 = lt[[1]]
#              pos2 = lt[[2]]
#  
#              ht = shiny_env$ht
#              pos = selectArea(ht, mark = FALSE, pos1 = pos1, pos2 = pos2,
#                  verbose = FALSE, ht_pos = shiny_env$ht_pos)
#  
#              row_index = unlist(pos[1, "row_index"])
#              column_index = unlist(pos[1, "column_index"])
#              m = ht@ht_list[[1]]@matrix
#              ht_select = Heatmap(m[row_index, column_index, drop = FALSE],
#                  col = ht@ht_list[[1]]@matrix_color_mapping@col_fun,
#                  show_heatmap_legend = FALSE,
#                  cluster_rows = FALSE, cluster_columns = FALSE)
#              draw(ht_select)
#          }
#      })
#  
#      output$ht_click_content = renderText({
#          if(is.null(input$ht_click)) {
#              "Not selected."
#          } else {
#              pos1 = ComplexHeatmap:::get_pos_from_click(input$ht_click)
#  
#              ht = shiny_env$ht
#              pos = selectPosition(ht, mark = FALSE, pos = pos1,
#                  verbose = FALSE, ht_pos = shiny_env$ht_pos)
#  
#              row_index = pos[1, "row_index"]
#              column_index = pos[1, "column_index"]
#              m = ht@ht_list[[1]]@matrix
#              v = m[row_index, column_index]
#  
#              glue("row index: {row_index}",
#                   "column index: {column_index}",
#                   "value: {v}", .sep = "\n")
#          }
#      })
#  }
#  
#  shinyApp(ui, server)

## ---- eval = FALSE------------------------------------------------------------
#  ui = fluidPage(
#      fluidRow(
#          column(width = 3,
#              plotOutput("main_heatmap", height = 300, width = 300,
#                  brush = "ht_brush", click = "ht_click")
#          ),
#          column(width = 3,
#            plotOutput("sub_heatmap", height = 300, width = 300)
#          )
#      ),
#      verbatimTextOutput("ht_click_content")
#  )

## ---- eval = FALSE------------------------------------------------------------
#  shiny_env = new.env()

## ---- eval = FALSE------------------------------------------------------------
#  	output$main_heatmap = renderPlot({
#          shiny_env$ht = draw(ht)
#          shiny_env$ht_pos = ht_pos_on_device(shiny_env$ht)
#      })

## ---- eval = FALSE------------------------------------------------------------
#  	output$sub_heatmap = renderPlot({
#          if(is.null(input$ht_brush)) {
#              grid.newpage()
#              grid.text("No region is selected.", 0.5, 0.5)
#          } else {
#              lt = ComplexHeatmap:::get_pos_from_brush(input$ht_brush)
#              pos1 = lt[[1]]
#              pos2 = lt[[2]]
#  
#              ht = shiny_env$ht
#              pos = selectArea(ht, mark = FALSE, pos1 = pos1, pos2 = pos2,
#                  verbose = FALSE, ht_pos = shiny_env$ht_pos)
#  
#              row_index = unlist(pos[1, "row_index"])
#              column_index = unlist(pos[1, "column_index"])
#              m = ht@ht_list[[1]]@matrix
#              ht_select = Heatmap(m[row_index, column_index, drop = FALSE],
#                  col = ht@ht_list[[1]]@matrix_color_mapping@col_fun,
#                  show_heatmap_legend = FALSE,
#                  cluster_rows = FALSE, cluster_columns = FALSE)
#              draw(ht_select)
#          }
#      })

## ---- eval = FALSE------------------------------------------------------------
#  	output$ht_click_content = renderText({
#          if(is.null(input$ht_click)) {
#              "Not selected."
#          } else {
#              pos1 = ComplexHeatmap:::get_pos_from_click(input$ht_click)
#  
#              ht = shiny_env$ht
#              pos = selectPosition(ht, mark = FALSE, pos = pos1,
#                  verbose = FALSE, ht_pos = shiny_env$ht_pos)
#  
#              row_index = pos[1, "row_index"]
#              column_index = pos[1, "column_index"]
#              m = ht@ht_list[[1]]@matrix
#              v = m[row_index, column_index]
#  
#              glue("row index: {row_index}",
#                   "column index: {column_index}",
#                   "value: {v}", .sep = "\n")
#          }
#      })