R/example.R

In jokergoo/InteractiveComplexHeatmap: Make Interactive Complex Heatmaps

lines = readLines(system.file("template", "ht-main.js", package = "InteractiveComplexHeatmap"))
i = which(grepl("^function create_clipboard", lines))
create_clipboard = paste(lines[i:length(lines)], collapse = "\n")

create_clipboard = gsub("'", "\\\\'", create_clipboard)
create_clipboard = gsub('"', '\\\\"', create_clipboard)
# == title
# Examples of interactive complex heatmaps
#
# == param
# -which An index of which example to use. The list of all examples can be obtained by executing `htShinyExample` with no argument.
#
# == details
# In every example, there is a Shiny app opened, which also includes source code that generates this app.
#
# == value
# A Shiny app object.
#
# == example
# # list all examples
# htShinyExample()
#
# if(interactive()) {
#     htShinyExample(4.2)
# }
htShinyExample = function(which) {
	if(missing(which)) {
		cat("There are following examples. Individual example can be run by e.g. htShinyExample(1.1).\n\n")
		for(i_cate in seq_along(examples)) {
			category = examples[[i_cate]]$category
			cat(strrep(clisymbols::symbol$line, 8), paste0(i_cate, "."), category, strrep(clisymbols::symbol$line, max(0, getOption("width") - 8 - nchar(category))), "\n")

			e = examples[[i_cate]]$example
			title = vapply(e, function(x) x$title, "")
			for(i in seq_along(title)) {
				lines = strwrap(title[i], width = getOption("width") - 5)
				lines[1] = paste0(" ", i_cate, ".", i, " ", lines[1])
				lines[-1] = paste0(strrep(" ", 1 + nchar(i_cate) + 1 + nchar(i) + 1), lines[-1])
				cat(paste(lines, collapse = "\n"))
				cat("\n")
			}
			cat("\n")
		}
	} else {
		which = as.character(which[1])
		ind = as.numeric(strsplit(which, "\\.")[[1]])
		if(length(ind) == 1) {
			ind = c(ind, 1)
		}

		i_cate = ind[1]
		i = ind[2]
		code = examples[[i_cate]]$example[[i]]$code
		title = examples[[i_cate]]$example[[i]]$title
		title = gsub("'", "\\\\'", title)
		title = gsub('"', '\\\\"', title)
		
		k = which(grepl("rmarkdown::run\\(", code))
		if(length(k)) {
			eval(parse(text = code[k]))
			return(invisible(NULL))
		}
		
		version = packageDescription('InteractiveComplexHeatmap', fields = "Version")

		library_calls = code[grepl("(library|require)\\(.*?\\)", code)]
		if(length(library_calls)) {

			line = grep("^assignInNamespace", code, value = TRUE)
			if(length(line)) {
				eval(parse(text = paste(line, collapse = "\n")))
			}

			required_pkgs = gsub("^.*(library|require)\\(([^)]*)\\).*$", "\\2", library_calls)
			loaded_pkgs = search()
			loaded_pkgs = loaded_pkgs[grepl("^package", loaded_pkgs)]
			loaded_pkgs = gsub("^package:", "", loaded_pkgs)
			for(pkg in required_pkgs) {
				
				check_pkg(pkg)
				
				if(!pkg %in% loaded_pkgs) {
					msg = paste0("Note: Namespace 'package:", pkg, "' is inserted into the search list. It might bring conflicts to some functions.")
					msg = strwrap(msg)
					msg[-1] = paste0("  ", msg[-1])
					message(paste(msg, collapse = "\n"))
				}
			}
		}
		message("Processing the heatmaps. It takes different time depending on examples...")

		if(any(grepl("htShiny\\(", code))) {

			code2 = paste(code, collapse = "\n")
			code2 = gsub("^\\s+||\\s+$", "", code2)

			original_htShiny = htShiny

			htShiny = function(ht = InteractiveComplexHeatmap:::get_last_ht(), ...) {
				html = qq("
<hr />
<div>
<h3>Information of this Shiny app<h3>
<h5>Description</h5>
<pre>@{ind[1]}.@{ind[2]} @{title}</pre>
<h5>Source code</h5>
<pre id=\"code\">
@{code2}
</pre>
<script src=\"https://cdn.jsdelivr.net/npm/clipboard@2.0.8/dist/clipboard.min.js\"></script>
<script>
@{create_clipboard}
create_clipboard(\"code\");
</script>
<hr />
<p>Generated by <a href=\"https://github.com/jokergoo/InteractiveComplexHeatmap\" target=\"_blank\">InteractiveComplexHeatmap</a> version @{version}</p>
</div>")
				original_htShiny(ht, ..., html = HTML(html))
			}
		} else {
			i = which(grepl("shinyApp\\(", code))
			code2 = c(code[seq_len(i-1)], "", code[seq(i, length(code))])
			code_line = paste(code, collapse = '\n')
			code_line = gsub("'", "\\\\'", code_line)
			code_line = gsub("<", "&lt;", code_line)
			code_line = gsub(">", "&gt;", code_line)
			code2[i] = qq("
ui = fluidPage(
    ui,
HTML('<hr /><div style=\"clear:both;\">
<h3>Information of this Shiny app<h3>
<h5>Description</h5>
<pre>@{ind[1]}.@{ind[2]} @{title}</pre>
<h5>Source code</h5>
<pre id=\"code\">
@{code_line}
</pre>
<script src=\"https://cdn.jsdelivr.net/npm/clipboard@2.0.8/dist/clipboard.min.js\"></script>
<script>
@{create_clipboard}
create_clipboard(\"code\");
</script>
<hr />
<p>Generated by <a href=\"https://github.com/jokergoo/InteractiveComplexHeatmap\" target=\"_blank\">InteractiveComplexHeatmap</a> version @{version}</p>
</div>')
)
")			
			code = code2
		}

		oe = try({
			app = eval(parse(text = code))
		})
		if(inherits(oe, "try-error")) {
			stop(oe)
		} else {
			app
		}
	}
}

get_examples = function() {

	if(identical(topenv(), .GlobalEnv)) {
		example_dir = "~/project/development/InteractiveComplexHeatmap/inst/examples"
	} else {
		example_dir = system.file("examples", package = "InteractiveComplexHeatmap")
	}

	example_files = list.files(path = example_dir, pattern = "example", full.names = TRUE)

	examples = list()
	ie = 0

	for(i_file in seq_along(example_files)) {

		examples[[i_file]] = list()

		text = readLines(example_files[i_file])

		category = text[1]
		category = gsub("^\\s*#\\s*", "", category)
		text = text[-1]
		examples[[i_file]]$category = category

		text = text[!grepl("^#{10,}$", text)]

		ind = which(grepl("^#+\\s*title:", text))
		ind2 = c(ind[-1] - 1, length(text))

		examples[[i_file]]$example = list()
		
		for(i in seq_along(ind)) {

			code = text[seq(ind[i]+1, ind2[i])]
			if(!any(grepl("(library|require)\\(ComplexHeatmap\\)", code))) {
				code = c("suppressPackageStartupMessages(library(ComplexHeatmap))", code)
			}
			if(!any(grepl("(library|require)\\(InteractiveComplexHeatmap\\)", code))) {
				code = c("suppressPackageStartupMessages(library(InteractiveComplexHeatmap))", code)
			}

			for(k in rev(seq_along(code))) {
				if(grepl("^\\s*$", code[k])) {
					code = code[-k]
				} else {
					break
				}
			}
			title = gsub("^#+\\s*title:\\s+", "", text[ind[i]])
			code = gsub("\\t", "    ", code)

			ie = ie + 1
			examples[[i_file]]$example[[i]] = list(
				title = title, 
				index = ie,
				code = code
			)
		}
	}

	examples
}


examples = get_examples()