## ---- 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") # } # })