inst/examples/08.example-indirect.R

In jokergoo/InteractiveComplexHeatmap: Make Interactive Complex Heatmaps

# Interactivate heatmaps indirectly generated by heatmap()/heatmap.2()/pheatmap()

########################################################
# title: Indirect use of pheatmap().

assignInNamespace("pheatmap", ComplexHeatmap::pheatmap, ns = "pheatmap")

library(SingleCellExperiment)
library(SC3)
library(scater)

if(0) {
	# the following code is runnable. To save the runtime of this example, the object `sce` is already generated. 
	sce <- SingleCellExperiment(
	    assays = list(
	        counts = as.matrix(yan),
	        logcounts = log2(as.matrix(yan) + 1)
	    ), 
	    colData = ann
	)

	rowData(sce)$feature_symbol <- rownames(sce)
	sce <- sce[!duplicated(rowData(sce)$feature_symbol), ]
	sce <- runPCA(sce)
	sce <- sc3(sce, ks = 2:4, biology = TRUE)
}

download.file("https://jokergoo.github.io/SC3_sce.rds", "SC3_sce.rds")
sce = readRDS("SC3_sce.rds")
file.remove("SC3_sce.rds")
# pheatmap() is internally used in sc3_plot_expression()
sc3_plot_expression(sce, k = 3)
htShiny()

##########################################################
# title: Indirect use of heatmap.2().

require(gplots)
assignInNamespace("heatmap.2", ComplexHeatmap:::heatmap.2, ns = "gplots")

library(GOexpress)
data(AlvMac)
set.seed(4543)
AlvMac_results <- GO_analyse(
	eSet = AlvMac, f = "Treatment",
	GO_genes=AlvMac_GOgenes, all_GO=AlvMac_allGO, all_genes=AlvMac_allgenes)
BP.5 <- subset_scores(
	result = AlvMac_results.pVal,
	namespace = "biological_process",
	total = 5,
	p.val=0.05)

# heatmap.2() is internally used in heatmap_GO()
heatmap_GO(
	go_id = "GO:0034142", result = BP.5, eSet=AlvMac, cexRow=0.4,
	cexCol=1, cex.main=1, main.Lsplit=30)
htShiny()


########################################################
# title: Two interactive heatmap widgets from indirect use of pheatmap().

assignInNamespace("pheatmap", ComplexHeatmap::pheatmap, ns = "pheatmap")

# We construct two functions p1() and p2() which internally generate heatmaps
# with pheatmap() but do not return the heatmap objects.
p1 = function(mat) {
	pheatmap::pheatmap(mat, col = c("white", "red"))
	1
}

p2= function(mat) {
	pheatmap::pheatmap(mat, col = c("white", "blue"))
	1
}

mat = matrix(rnorm(100), 10)

# When p1() or p2() is executed, pheatmap::pheatmap actually has already been 
# replaced to ComplexHeatmap::pheatmap.
pdf(NULL)
p1(mat)
dev.off()
# Since now there will be two interactive heatmap widgets, we need to explicitely
# extract the heatmap object.
ht1 = ComplexHeatmap:::get_last_ht()

pdf(NULL)
p2(mat)
dev.off()
ht2 = ComplexHeatmap:::get_last_ht()

ui = mainPanel(
    InteractiveComplexHeatmapOutput("heatmap_1"),
    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)