<%=title%>
==================

**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 = NA}
library(knitr)
library(markdown)
options(width = 100)
options(digits = 3)
opts_chunk$set(
    comment = "#>",
    fig.path = "figure_cola/",
    warning = FALSE,
    message = FALSE
)
suppressPackageStartupMessages(library(ComplexHeatmap))
suppressPackageStartupMessages(library(genefilter))
ht_opt$message = FALSE

n_cores = cola:::get_nc(cores)
```

<% res_rh = object; n_cores = cores -%>

## Summary

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

<% if(!same_var_name) { -%>

First the variable is renamed to `res_rh`.

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

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

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

```{r}
res_rh
```

The call of `hierarchical_partition()` was:

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

Dimension of the input matrix:

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

All the methods that were tried:

```{r}
res_rh@param$combination_method
```

### 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 = NA}
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_rh))) { -%>
densityHeatmap(mat, ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=cores%>)
<% } else { -%>
densityHeatmap(mat, top_annotation = HeatmapAnnotation(df = get_anno(res_rh), 
    col = get_anno_col(res_rh)), ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=cores%>)
<% } -%>
```

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

Some values about the hierarchy:

```{r}
all_nodes(res_rh)
all_leaves(res_rh)
node_info(res_rh)
```

In the output from `node_info()`, there are the following columns:

- `id`: The node id.
- `best_method`: The best method selected.
- `depth`: Depth of the node in the hierarchy.
- `best_k`: Best number of groups of the partition on that node.
- `n_columns`: Number of columns in the submatrix.
- `n_signatures`: Number of signatures with the `best_k`.
- `p_signatures`: Proportion of hte signatures in total number of rows in the matrix.
- `is_leaf`: Whether the node is a leaf.

Labels of nodes are encoded in a special way. The number of digits
correspond to the depth of the node in the hierarchy and the value of the
digits correspond to the index of the subgroup in the current node, E.g. a label
of “012” means the node is the second subgroup of the partition which is the
first subgroup of the root node.

### Suggest the best k

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

Following table shows the best `k` (number of partitions) for each node in the
partition hierarchy. Clicking on the node name in the table goes to the
corresponding section for the partitioning on that node.

[The cola vignette](https://jokergoo.github.io/cola_vignettes/cola.html#toc_13)
explains the definition of the metrics used for determining the best
number of partitions.


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

```{r, echo = FALSE}
tb = suggest_best_k(res_rh)
stop_reason = attr(tb, "stop_reason")
stop_reason = sapply(stop_reason, function(x) {
    if(is.null(x)) {
        return(NA)
    } else {
        return(cola:::STOP_REASON_INDEX[x])
    }
})

tb = cbind(node_id = paste0("Node", rownames(tb)), tb, stringsAsFactors = FALSE)

tb$node_id[!tb$is_leaf] = qq("[Node@{tb$node[!tb$is_leaf]}](#node@{tb$node[!tb$is_leaf]})", collapse = FALSE)
tb$node_id[tb$is_leaf] = qq("Node@{tb$node[tb$is_leaf]}-leaf", collapse = FALSE)
tb$is_leaf = ifelse(tb$is_leaf, "\u2713", "")

tb$is_leaf = ifelse(is.na(stop_reason), tb$is_leaf, paste0(tb$is_leaf, " (", stop_reason, ")"))
tb$is_leaf = gsub("c", "&#99;", tb$is_leaf)
colnames(tb) = c("Node", "Code", "Best method", "Is leaf", "Best k", "1-PAC", "Mean silhouette", "Concordance", "#samples", "")
tb[, "1-PAC"] = sprintf("%.2f", tb[, "1-PAC"])
tb[, "Mean silhouette"] = sprintf("%.2f", tb[, "Mean silhouette"])
tb[, "Concordance"] = sprintf("%.2f", tb[, "Concordance"])
tb[is.na(tb[, "Best k"]), "Best k"] = ""
tb[tb[, "1-PAC"] == "NA", "1-PAC"] = ""
tb[tb[, "Mean silhouette"] == "NA", "Mean silhouette"] = ""
tb[tb[, "Concordance"] == "NA", "Concordance"] = ""
tb[tb[, 3] == "not applied", 3] = "<span style='color:grey;'><i>not applied</i></span>"
kable(tb[, -2], row.names = FALSE)
```


```{r, echo = FALSE, results = "asis"}
reasons = sort(unique(stop_reason[!is.na(stop_reason)]))
if(length(reasons) > 0) cat("Stop reason: ")
for(i in seq_along(reasons)) {
    cat(reasons[i], ") ", names(which(cola:::STOP_REASON_INDEX == reasons[i])), " ", sep = "")
}
cat("\n\n\\*\\*: 1-PAC > 0.95, \\*: 1-PAC > 0.9")
```


### Partition hierarchy

The nodes of the hierarchy can be merged by setting the `merge_node` parameters. Here we 
control the hierarchy with the `min_n_signatures` parameter. The value of `min_n_signatures` is
from `node_info()`.

<% df_foo = node_info(res_rh)
    n_signatures = df_foo$n_signatures[!df_foo$is_leaf]
    n_signatures = sort(n_signatures[!is.na(n_signatures)])

max_depth = max_depth(res_rh)
-%>

```{r, echo = FALSE, message = NA}
t1 = Sys.time()
message(qq("* collecting classifications for each ndoe height"), appendLF = FALSE)
```

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(ns in n_signatures) { -%>
knitr_add_tab_item('collect_classes(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>))', 'n_signatures \u2265 <%=ns%>', 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(ns in n_signatures) { -%>
knitr_add_tab_item('get_classes(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>))', 'n_signatures \u2265 <%=ns%>', 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"
}
top_n = pretty(c(0, nrow(res_rh)*0.1))
top_n = top_n[length(top_n)]
-%>


### Top rows heatmap

Heatmaps of the top rows:

<% 
all_top_value_methods = unique(sapply(res_rh@.env$combination_methods, function(x) x[1]))
n_top_value_method = length(all_top_value_methods)
if(n_top_value_method <= 4) {
    fig_width = 14/4 * n_top_value_method
    fig_height = 14/4
} else {
    fig_width = 14
    fig_height = 14/n_top_value_method
}
-%>

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

```{r top-rows-heatmap, fig.width = <%=fig_width%>, fig.height = <%=fig_height%>}
top_rows_heatmap(res_rh)
```

Top rows on each node:

```{r top-rows-overlap, fig.width = 8, fig.height = 6}
top_rows_overlap(res_rh, method = "upset")
```


### <%=dr_method%> plot

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

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

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% for(ns in n_signatures) { -%>
knitr_add_tab_item('par(mfrow = c(1, 2))
dimension_reduction(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>),
    method = "<%=dr_method%>", top_value_method = "SD", top_n = <%=top_n%>, scale_rows = FALSE)
dimension_reduction(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>),
    method = "<%=dr_method%>", top_value_method = "ATC", top_n = <%=top_n%>, scale_rows = TRUE)', 'n_signatures \u2265 <%=ns%>', prefix = 'dimension-reduction-by-depth', opt = "fig.width = 14, fig.height = 7, out.width = '100%'")
<%}-%>
knitr_insert_tabs('dimension-reduction-by-depth')
```


<% 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 = NA}
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(ns in n_signatures) { -%>
knitr_add_tab_item('get_signatures(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>))', 'n_signatures \u2265 <%=ns%>', opt = 'results="hide"', prefix = 'get-signatures-from-hierarchical-partition')
<%}-%>
knitr_insert_tabs('get-signatures-from-hierarchical-partition')
```

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

<% } -%>

Compare signatures from different nodes:

```{r, prefix = "comapre_signatures-from-hierarchical-partition"}
compare_signatures(res_rh, verbose = FALSE)
```

If there are too many signatures, `top_signatures = ...` can be set to only show the 
signatures with the highest FDRs. Note it only works on every node and the final signatures
are the union of all signatures of all nodes.

```{r, eval = FALSE}
# code only for demonstration
# e.g. to show the top 500 most significant rows on each node.
tb = get_signature(res_rh, top_signatures = 500)
```

<% has_known_anno = FALSE
if(!is.null(res_rh@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 = NA}
message(qq("* testing correlation of subgroups to known annotations"))
```

```{r, results = 'asis', echo = FALSE, include = TRUE}
<% for(ns in n_signatures) { -%>
knitr_add_tab_item('test_to_known_factors(res_rh, merge_node = merge_node_param(min_n_signatures = <%=ns%>))', 'n_signatures \u2265 <%=ns%>', 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, message = NA}
fs = 2
is_hc = TRUE
single_report = FALSE
all_parents = setdiff(all_nodes(res_rh), all_leaves(res_rh))
# all_parents = all_nodes(res_rh)
n_section = length(all_parents)
i_section = 0
.e = environment()
all_k = res_rh@list[[1]]@k

md_list = lapply(seq_along(all_parents), function(ind) {
    i_section = ind
    node = all_parents[ind]
    top_value_method = res_rh[[node]]@top_value_method
    partition_method = res_rh[[node]]@partition_method

    tmpfile = tempfile(tmpdir = .ENV$TEMP_DIR)
    
    brew(file.path(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)
    devlt = dev.list()
    if(names(devlt)[1] == "quartz_off_screen") {
        invisible(dev.off())
    }
    dev.off()
    return(txt)
})

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

## Session info

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


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

<script type="text/javascript">
$(function() {
    $("#TOC > ul > li > a").remove();
}); 
</script>
