## ---- 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("(x1, y1)", 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("(x2, y2)", 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("nr = 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("nc = 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")
# }
# })