inst/examples/06.example-shiny-dynamic.R

In jokergoo/InteractiveComplexHeatmap: Make Interactive Complex Heatmaps

# Dynamically generate heatmap widget in Shiny app

#######################################################
# title: The matrix with different dimensions is dynamically generated.

library(ComplexHeatmap)

ui = fluidPage(
    sliderInput("n", "Number of rows and columns", value = 10, min = 5, max = 50),
    InteractiveComplexHeatmapOutput()
)

server = function(input, output, session) {
	observe({
		n = input$n
		m = matrix(rnorm(n*n), n)
		ht = Heatmap(m, column_title = paste0("A ", n, "x", n, " matrix"))
		makeInteractiveComplexHeatmap(input, output, session, ht)
	})

}
shiny::shinyApp(ui, server)


######################################################
# title: Reorder by a column that is specified by user.

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,
			cell_fun = function(j, i, x, y, w, h, fill) {
				if(j == input$column) {
					grid.rect((j-0.5)/ncol(m), 0.5, width = w, height = 1, 
						gp = gpar(fill = "transparent", lwd = 2, lty = 2))
				}
			})
		makeInteractiveComplexHeatmap(input, output, session, ht)
	})
}
shiny::shinyApp(ui, server)


#############################################################
# title: Dynamically generate the widget with InteractiveComplexHeatmapModal(). The modal is triggered by an action button.

library(ComplexHeatmap)

ui = fluidPage(
    actionButton("show_heatmap", "Generate_heatmap"),
)

server = function(input, output, session) {
	observeEvent(input$show_heatmap, {
		m = matrix(rnorm(100), 10)
		ht = Heatmap(m)
		InteractiveComplexHeatmapModal(input, output, session, ht)
	})
}
shiny::shinyApp(ui, server)


#############################################################
# title: Dynamically select interactive heatmaps. The modal is triggered by radio buttons.

library(ComplexHeatmap)
ui = fluidPage(
	radioButtons("select", "Select", c("Numeric" = 1, "Character" = 2)),
    actionButton("show_heatmap", "Generate_heatmap"),
)

get_heatmap = 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)
		ht = get_heatmap(i)
		InteractiveComplexHeatmapModal(input, output, session, ht)
	})
}
shiny::shinyApp(ui, server)


#############################################################
# title: Dynamically generate the widget. A customized Javascript code is inserted after the UI to change the default behavior of the action button.

library(ComplexHeatmap)

ui = fluidPage(
    actionButton("show_heatmap", "Generate_heatmap"),
)

server = function(input, output, session) {
	observeEvent(input$show_heatmap, {
		m = matrix(rnorm(100), 10)
		ht = Heatmap(m)
		InteractiveComplexHeatmapModal(input, output, session, ht,
			cancel_action = "hide",

			# From the second click of the action button, it just switches the visibility of the
			# heatmap modal while not regenerate it repeatedly.
			# Here I simply change the id of the action button to disconnect the binding.
			js_code = function(heatmap_id) {
                qq("$('#show_heatmap').click(function() {
                    $('#@{heatmap_id}_heatmap_modal_background').toggle('slow');
                }).text('Show/hide heatmap').
                   attr('id', 'show_heatmap_toggle');
            ")}
		)
	})
}
shiny::shinyApp(ui, server)

#############################################################
# title: The widget is generated by InteractiveComplexHeatmapWidget() where the UI is directly put in the place defined by htmlOutput().

library(ComplexHeatmap)

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)

#############################################################
# title: The widget is generated by InteractiveComplexHeatmapWidget() and a customized Javascript code is inserted after the UI.

library(ComplexHeatmap)

ui = tabsetPanel(
    tabPanel("close_button = FALSE", 
    	div(p("The JavaScript code directly changes the visibility of the htmOutput."),
		    actionButton("show_heatmap1", "Generate_heatmap"),
		    htmlOutput("heatmap_output1")
		)
	),
	tabPanel("cancel_action = 'hide'", 
    	div(p("The behavior of the close action is changed to 'hide' so that the interactive heatmap widget can be closed which hides the widget and clicking on the button changes its visibility."),
		    actionButton("show_heatmap2", "Generate_heatmap"),
		    htmlOutput("heatmap_output2")
		)
	)
)

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_output1", close_button = FALSE,
			
			js_code = "
			    $('#show_heatmap1').click(function() {
                    $('#heatmap_output1').toggle('slow');
                }).text('Show/hide heatmap').
                   attr('id', 'show_heatmap_toggle1');
            "
		)
	})

	observeEvent(input$show_heatmap2, {
		InteractiveComplexHeatmapWidget(input, output, session, ht, "ht",
			output_id = "heatmap_output2", cancel_action = "hide",
			
			js_code = function(heatmap_id) {
                qq("$('#show_heatmap2').click(function() {
                    $('#@{heatmap_id}_heatmap_widget').toggle('slow');
                }).text('Show/hide heatmap').
                   attr('id', 'show_heatmap_toggle2');
            ")}
		)
	})
}
shiny::shinyApp(ui, server)