cola Report for Hierarchical Partitioning
==================

**Date**: `r format(as.POSIXlt(Sys.time()), usetz = TRUE)`, **cola version**: `r installed.packages()["cola", "Version"]`

----------------------------------------------------------------

<style type='text/css'>
<%
css = paste(readLines(paste0(TEMPLATE_DIR, "/custom.css")), collapse = "\n") -%>
<%= css %>
</style>

```{r, echo = FALSE, message = FALSE}
library(knitr)
library(markdown)
options(markdown.HTML.options = setdiff(c(getOption("markdown.HTML.options")), "base64_images"))
options(width = 100)
options(digits = 3)
opts_chunk$set(
    comment = "#>",
    fig.path = "figure_cola/",
    warning = FALSE,
    message = FALSE
)
suppressPackageStartupMessages(library(ComplexHeatmap))
suppressPackageStartupMessages(library(genefilter))
```

<% res_hc = object -%>

## Summary

<% same_var_name = var_name == "res_hc" -%>

<% if(!same_var_name) { -%>

First the variable is renamed to `res_hc`.

```{r, eval = FALSE, echo = TRUE}
res_hc = <%=var_name%>
```
<% } -%>

```{r, echo = FALSE}
res_hc = object
```

The partition hierarchy and all available functions which can be applied to `res_hc` object.

```{r}
res_hc
```

The call of `hierarchical_partition()` was:

```{r, echo = FALSE}
cat(paste(deparse(res_hc@call, width.cutoff = 80), collapse = "\n"), "\n")
```

Dimension of the input matrix:

```{r}
mat = get_matrix(res_hc)
dim(mat)
```

### Density distribution

The density distribution for each sample is visualized as one column in the following heatmap.
The clustering is based on the distance which is the Kolmogorov-Smirnov statistic between two distributions.

```{r, echo = FALSE, message = FALSE}
t1 = Sys.time()
message(qq("* making density heatmap of global distribution for each sample (@{ncol(mat)} samples)"), appendLF = FALSE)
```

```{r density-heatmap}
library(ComplexHeatmap)
<% if(is.null(get_anno(res_hc))) { -%>
densityHeatmap(mat, ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=mc.cores%>)
<% } else { -%>
densityHeatmap(mat, top_annotation = HeatmapAnnotation(df = get_anno(res_hc), 
    col = get_anno_col(res_hc)), ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=mc.cores%>)
<% } -%>
```

```{r, echo = FALSE, message = FALSE}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1))))
```

Some values about the hierarchy:

```{r}
max_depth(res_hc)
all_nodes(res_hc)
all_leaves(res_hc)
```

**cola** uses a special way to encode the node in the hierarchy. The length of
the node name is the depth of the node in the hierarchy and the substring
excluding the last digit is the node name of the parent node. E.g. for the
node 0011, the depth is 4 and the parent node is 001. For each node, the last
digit represents the index of the subgroup detected in parent node. and 0
represents all other subgroups. E.g. 02 means this node contains samples which
belong to subgroup 2 when doing consensus partition at node 0 (subgroup 2 is
selected as a node because the intra-group distance is smallest compared to
other subgroups), and 00 contains samples which do not belong to subgroup 2 at
node 0.

```{r, echo = FALSE, message = FALSE}
message(qq("* top rows are extracted by '@{res_hc[1]@top_value_method}' method"))
message(qq("* subgroups are detected by '@{res_hc[1]@partition_method}' method"))
```

### Suggest the best k

```{r, echo = FALSE, message = FALSE}
message("* suggesting the best k for each node")
```

Following table shows the best `k` (number of partitions) for each node in the partition hierarchy:

```{r, eval = FALSE}
suggest_best_k(res_hc)
```

```{r, echo = FALSE}
tb = suggest_best_k(res_hc)
tb = cbind(node_id = paste0("Node", rownames(tb)), tb, stringsAsFactors = FALSE)
# ind = which(tb[, ncol(tb)] == "parent")
# tb$node_id[ind] = qq("[@{tb$node_id[ind]}](#@{tb$node_id[ind]})", collapse = FALSE)
tb$node_id = qq("[@{tb$node_id}](#@{tb$node_id})", collapse = FALSE)
colnames(tb) = c("", "The best k", "1-PAC", "Mean silhouette", "Concordance", "Number of samples", "")
kable(tb, row.names = FALSE)
```

### Partition hierarchy

<% max_depth = max_depth(res_hc) -%>

```{r, echo = FALSE, message = FALSE}
t1 = Sys.time()
message(qq("* collecting classifications for each depth (@{max_depth}..2)"), appendLF = FALSE)
```

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(depth in max_depth:2) { -%>
knitr_add_tab_item('collect_classes(res_hc, depth = <%=depth%>)', 'depth = <%=depth%>', prefix = 'collect-classes-from-hierarchical-partition')
<% } -%>
knitr_insert_tabs('collect-classes-from-hierarchical-partition')
```

Following shows the table of the partitions (You need to click the **show/hide
code output** link to see it).

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(depth in max_depth:2) { -%>
knitr_add_tab_item('get_classes(res_hc, depth = <%=depth%>)', 'depth = <%=depth%>', prefix = 'get-classes-from-hierarchical-partition', hide_and_show = TRUE)
<% } -%>
knitr_insert_tabs('get-classes-from-hierarchical-partition')
```

<% 
dr_method = NULL
if(is.null(dr_method)) {
    oe = try(loadNamespace("umap"), silent = TRUE)
    if(!inherits(oe, "try-error")) {
        dr_method = "UMAP"
    }
}
if(is.null(dr_method)) {
    oe = try(loadNamespace("Rtsne"), silent = TRUE)
    if(!inherits(oe, "try-error")) {
        dr_method = "t-SNE"
    }
}
if(is.null(dr_method)) {
    dr_method = "PCA"
}
-%>

### <%=dr_method%> plot

<%=dr_method%> plot which shows how samples are separated.

```{r, echo = FALSE, message = FALSE}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* making PCA plots"), appendLF = FALSE)
```

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% for(depth in max_depth:2) { -%>
knitr_add_tab_item('dimension_reduction(res_hc, depth = <%=depth%>, method = "<%=dr_method%>")', 'depth = <%=depth%>', prefix = 'dimension-reduction-by-depth')
<%}-%>
knitr_insert_tabs('dimension-reduction-by-depth')
```

Or you can also do it on each parent node:

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% all_parents = setdiff(all_nodes(res_hc), all_leaves(res_hc))
for(p in all_parents) { -%>
knitr_add_tab_item('dimension_reduction(res_hc, parent_node = "<%=p%>", method = "<%=dr_method%>")', 'node = "<%=p%>"', prefix = 'dimension-reduction-by-node')
<%}-%>
knitr_insert_tabs('dimension-reduction-by-node')
```

<% if(max_depth >= 2) { %>

### Signature heatmap

Signatures on the heatmap are the union of all signatures found on every node
on the hierarchy. The number of k-means on rows are automatically selected by the function.

```{r, echo = FALSE, message = FALSE}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* making signature heatmaps"), appendLF = FALSE)
```

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% for(depth in max_depth:2) { -%>
knitr_add_tab_item('get_signatures(res_hc, depth = <%=depth%>)', 'depth = <%=depth%>', opt = 'results="hide"', prefix = 'get-signatures-from-hierarchical-partition')
<%}-%>
knitr_insert_tabs('get-signatures-from-hierarchical-partition')
```

```{r, echo = FALSE, message = FALSE}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1))));
```

<% } -%>

<% has_known_anno = FALSE
if(!is.null(res_hc@list[['0']]@anno)) { 
has_known_anno = TRUE -%>

### Test to known annotations

Test correlation between subgroups and known annotations. If the known
annotation is numeric, one-way ANOVA test is applied, and if the known
annotation is discrete, chi-squared contingency table test is applied.

```{r, echo = FALSE, message = FALSE}
message(qq("* testing correlation of subgroups to known annotations"))
```

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% for(depth in max_depth:2) { -%>
knitr_add_tab_item('test_to_known_factors(res_hc, depth = <%=depth%>)', 'depth = <%=depth%>', prefix = 'test-to-known-factors-from-hierarchical-partition')
<%}-%>
knitr_insert_tabs('test-to-known-factors-from-hierarchical-partition')
```


<% } -%>

## Results for each node

```{r, results = "asis", echo = FALSE}
fs = 2
is_hc = TRUE
single_report = FALSE
# all_parents = setdiff(all_nodes(res_hc), all_leaves(res_hc))
all_parents = all_nodes(res_hc)
n_section = length(all_parents)
i_section = 0
.e = environment()
all_k = res_hc@list[[1]]@k
md_list = mclapply(seq_along(all_parents), function(ind) {
    i_section = ind
    node = all_parents[ind]
    top_value_method = res_hc[[node]]@top_value_method
    partition_method = res_hc[[node]]@partition_method
    
    tmpfile = tempfile(tmpdir = cola:::.ENV$TEMP_DIR)
    
    brew(file.path(cola:::TEMPLATE_DIR, "section_template.Rmd-template"), tmpfile)
    rmd = paste(readLines(tmpfile), collapse = "\n")
    file.remove(tmpfile)

    ComplexHeatmap:::dev.null()
    txt = knit(text = rmd, quiet = TRUE, envir = .e)
    dev.off()
    return(txt)
}, mc.cores = mc.cores)

for(i in seq_along(md_list)) {
    cat(md_list[[i]], "\n")
}
```

## Session info

```{r}
sessionInfo()
```


```{r, echo = FALSE, message = FALSE}
message("-----------------------------------------------------------------")
```

