<%=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_list = object; n_cores = cores -%>

## Summary

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

<% if(!same_var_name) { -%>

First the variable is renamed to `res_list`.

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

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

All available functions which can be applied to this `res_list` object:

```{r}
res_list
```

The call of `run_all_consensus_partition_methods()` was:

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

Dimension of the input matrix:

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

### Density distribution

The density distribution for each sample is visualized as in 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_list))) { -%>
densityHeatmap(mat, ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=n_cores%>)
<% } else { -%>
densityHeatmap(mat, top_annotation = HeatmapAnnotation(df = get_anno(res_list), 
    col = get_anno_col(res_list)), ylab = "value", cluster_columns = TRUE, show_column_names = FALSE,
    mc.cores = <%=n_cores%>)
<% } -%>
```

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

```{r, echo = FALSE, message = NA}
n_top_value_method = length(res_list@top_value_method)
n_partition_method = length(res_list@partition_method)
n_method = n_top_value_method * n_partition_method
message(qq("* top rows are extracted by '@{paste(res_list@top_value_method, collapse = ', ')}' methods"))
message(qq("* subgroups are detected by '@{paste(res_list@partition_method, collapse = ', ')}' methods"))
message(qq("  - in total @{n_method} combinations of methods"))
```

### Suggest the best k

```{r, echo = FALSE, message = NA}
t1 = Sys.time()
message("* Suggesting the best k for each method", appendLF = FALSE)
```

Folowing table shows the best `k` (number of partitions) for each combination
of top-value methods and partitioning methods. Clicking on the method name in
the table goes to the corresponding section for a single combination of methods.

[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_list)
```

```{r, echo = FALSE}
tb = suggest_best_k(res_list)
rownames(tb) = qq("[@{rownames(tb)}](#@{gsub(':', '-', tolower(rownames(tb)))})", collapse = FALSE)
if(ncol(tb) == 5) {
    colnames(tb) = c("The best k", "1-PAC", "Mean silhouette", "Concordance", "")
} else {
    colnames(tb) = c("The best k", "1-PAC", "Mean silhouette", "Concordance", "", "Optional k")
}
kable(tb)
```

\*\*: 1-PAC > 0.95, \*: 1-PAC > 0.9


```{r, echo = FALSE}
fs = min(c(3*n_top_value_method, 14))/n_partition_method
```

### CDF of consensus matrices

Cumulative distribution function curves of consensus matrix for all methods.

```{r, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* making empirical cumulative distribution curves for all methods"), appendLF = FALSE)
```

```{r collect-plots, fig.width = fs*n_partition_method, fig.height = fs*n_top_value_method, results = "hide"}
collect_plots(res_list, fun = plot_ecdf)
```

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

### Consensus heatmap

Consensus heatmaps for all methods. ([What is a consensus heatmap?](https://jokergoo.github.io/cola_vignettes/cola.html#toc_9))

```{r, results = "asis", echo = FALSE, include = TRUE}
<% all_k = res_list@list[[1]]@k
fs = min(c(3*length(res_list@top_value_method), 14))/length(res_list@top_value_method)
n_top_value_method = length(res_list@top_value_method)
n_partition_method = length(res_list@partition_method)
n_method = n_top_value_method * n_partition_method
for(k in all_k) { -%>
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - consensus heamtaps for all methods (k = <%=k%>)<%=ifelse(n_cores > 1, paste0(', ', n_cores, ' cores'), '')%>", appendLF = FALSE)
knitr_add_tab_item('collect_plots(res_list, k = <%=k%>, fun = consensus_heatmap, cores = <%=n_cores%>)', 'k = <%=k%>', opt = 'fig.width = <%=fs*n_partition_method%>, fig.height = <%=fs*n_top_value_method%>, results = "hide"', prefix = 'collect-consensus-heatmap')
<% } -%>
knitr_insert_tabs('collect-consensus-heatmap')
```

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

### Membership heatmap

Membership heatmaps for all methods. ([What is a membership heatmap?](https://jokergoo.github.io/cola_vignettes/cola.html#toc_12))

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - membership heamtap for all methods (k = <%=k%>)<%=ifelse(n_cores > 1, paste0(', ', n_cores, ' cores'), '')%>", appendLF = FALSE)
knitr_add_tab_item('collect_plots(res_list, k = <%=k%>, fun = membership_heatmap, cores = <%=n_cores%>)', 'k = <%=k%>', opt = 'fig.width =<%=fs*n_partition_method%>, fig.height = <%=fs*n_top_value_method%>, results = "hide"', prefix = 'collect-membership-heatmap')
<%}-%>
knitr_insert_tabs('collect-membership-heatmap')
```

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

### Signature heatmap

Signature heatmaps for all methods. ([What is a signature heatmap?](https://jokergoo.github.io/cola_vignettes/cola.html#toc_21))

<% if(res_list@list[[1]]@scale_rows) { %>
Note in following heatmaps, rows are scaled.
<% } %>

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - signature heamtap for all methods (k = <%=k%>)<%=ifelse(n_cores > 1, paste0(', ', n_cores, ' cores'), '')%>", appendLF = FALSE)
knitr_add_tab_item('collect_plots(res_list, k = <%=k%>, fun = get_signatures, cores = <%=n_cores%>)', 'k = <%=k%>', opt = 'fig.width = <%=fs*n_partition_method%>, fig.height = <%=fs*n_top_value_method%>, results = "hide"', prefix = 'collect-get-signatures')
<%}-%>
knitr_insert_tabs('collect-get-signatures')
```

```{r, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* getting statistics for all methods"), appendLF = FALSE)
```

### Statistics table

The statistics used for measuring the stability of consensus partitioning.
([How are they
defined?](https://jokergoo.github.io/cola_vignettes/cola.html#toc_13))

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('get_stats(res_list, k = <%=k%>)', 'k = <%=k%>', prefix = 'get-stats-from-consensus-partition-list')
<%}-%>
knitr_insert_tabs('get-stats-from-consensus-partition-list')
```

Following heatmap plots the partition for each combination of methods and the
lightness correspond to the silhouette scores for samples in each method. On
top the consensus subgroup is inferred from all methods by taking the mean
silhouette scores as weight.

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('collect_stats(res_list, k = <%=k%>)', 'k = <%=k%>', opt = 'fig.width = 6, fig.width = 9', prefix = 'collect-stats-from-consensus-partition-list')
<%}-%>
knitr_insert_tabs('collect-stats-from-consensus-partition-list')
```

### Partition from all methods

```{r, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* collecting classifications for all methods"), appendLF = FALSE)
```

Collect partitions from all methods:

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - classifications from all methods (k = <%=k%>)", appendLF = FALSE)
knitr_add_tab_item('collect_classes(res_list, k = <%=k%>)', 'k = <%=k%>', opt = 'fig.width = 9, fig.height = 8', prefix = 'collect-classes-from-consensus-partition-list')
<%}-%>
knitr_insert_tabs('collect-classes-from-consensus-partition-list')
```

```{r, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("* overlaping top rows from different top-value methods"), appendLF = FALSE)
```

### Top rows overlap

<% if(length(res_list@top_value_method) > 1) { -%>

Overlap of top rows from different top-row methods:

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(top_n in res_list@list[[1]]@top_n) { -%>
knitr_add_tab_item('top_rows_overlap(res_list, top_n = <%=top_n%>, method = "euler")', 'top_n = <%=top_n%>', opt = 'fig.width = 5, fig.height = 5', prefix = 'top-rows-overlap-by-euler')
<%}-%>
knitr_insert_tabs('top-rows-overlap-by-euler')
```

Also visualize the correspondance of rankings between different top-row methods:

```{r, results = "asis", echo = FALSE, include = TRUE}
<% for(top_n in res_list@list[[1]]@top_n) { -%>
knitr_add_tab_item('top_rows_overlap(res_list, top_n = <%=top_n%>, method = "correspondance")', 'top_n = <%=top_n%>', opt = 'fig.width = 14, fig.height = 8', prefix = 'top-rows-overlap-by-correspondance')
<%}-%>
knitr_insert_tabs('top-rows-overlap-by-correspondance')
```

<% }-%>

Heatmaps of the top rows:

<% 
n_top_value_method = length(res_list@top_value_method)
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, results = "asis", echo = FALSE, include = TRUE}
<% for(top_n in res_list@list[[1]]@top_n) { -%>
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - comparing top row methods by heatmap (top_n = <%=top_n%>)", appendLF = FALSE)
knitr_add_tab_item('top_rows_heatmap(res_list, top_n = <%=top_n%>)', 'top_n = <%=top_n%>', opt = 'fig.width = <%=fig_width%>, fig.height = <%=fig_height%>', prefix = 'top-rows-heatmap')
<%}-%>
knitr_insert_tabs('top-rows-heatmap')
```

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

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

### Test to known annotations

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

Following tests 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, results = 'asis', echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('test_to_known_factors(res_list, k = <%=k%>)', 'k = <%=k%>', prefix = 'test-to-known-factors-from-consensus-partition-list')
<%}-%>
knitr_insert_tabs('test-to-known-factors-from-consensus-partition-list')
```


<%}-%> 

## Results for each method

```{r, results = "asis", echo = FALSE, message = NA}
fs = min(c(3*length(res_list@top_value_method), 14))/length(res_list@top_value_method)
is_hc = FALSE
single_report = FALSE
node = NULL
n_section = n_top_value_method * n_partition_method
i_section = 0
comb = expand.grid(res_list@partition_method, res_list@top_value_method, stringsAsFactors = FALSE)[, 2:1]
.e = environment()
md_list = lapply(seq_len(nrow(comb)), function(ind) {
    i_section = ind
    top_value_method = comb[ind, 1]
    partition_method = comb[ind, 2]
    
    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>
