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

<% 
if(is_hc) {
    chunk_prefix = paste("node", node, sep = "-")
    res = res_rh[node]
} else {
    if(single_report) {
        chunk_prefix = paste(top_value_method, partition_method, sep = "-")
    } else {
        tb = suggest_best_k(res_list)
        nm = paste(top_value_method, partition_method, sep = ":")
        mark = tb[nm, colnames(tb) == ""]
        chunk_prefix = paste(top_value_method, partition_method, sep = "-")
        res = res_list[top_value_method, partition_method]
    }
} 
n_cores = 1
-%>

<% if(!single_report) { %>
<% if(is_hc) { %>
### Node<%=paste0(node, ifelse(is_leaf_node(res_rh, node), "-leaf", ""))%>

<% if(is_leaf_node(res_rh, node)) { %>
Parent node: [Node<%=substr(node, 1, nchar(node)-1)%>](#Node<%=substr(node, 1, nchar(node)-1)%>).
The subset of columns are treated as a leaf node in the hierarchical partitioning.
The columns will not further split. The reason for stopping the partitioning is: <%=attr(res_rh[[node]], "stop_reason")%>

<% } else if(node == "0"){ -%>

<% cnode = get_children_nodes(res_rh, node) 
   cnode_is_leaf = sapply(cnode, function(x) is_leaf_node(res_rh, x)) -%>
Child nodes: 
<% for(i in seq_along(cnode)) { -%>
    <% current_node = paste0("Node", cnode[i], ifelse(cnode_is_leaf[i], "-leaf", "")) -%>
    <% if(!cnode_is_leaf[i]) { -%>
        [<%=current_node%>](#<%=tolower(current_node)%>)
    <% } else {-%>
        <%=current_node%>
    <% } -%>
    <%=ifelse(i==length(cnode), ".", ",")%>
<% } -%>
<% } else { -%>

Parent node: [Node<%=substr(node, 1, nchar(node)-1)%>](#Node<%=substr(node, 1, nchar(node)-1)%>).
<% cnode = get_children_nodes(res_rh, node) 
   cnode_is_leaf = sapply(cnode, function(x) is_leaf_node(res_rh, x)) -%>
Child nodes: 
<% for(i in seq_along(cnode)) { -%>
    <% current_node = paste0("Node", cnode[i], ifelse(cnode_is_leaf[i], "-leaf", "")) -%>
    <% if(!cnode_is_leaf[i]) { -%>
        [<%=current_node%>](#<%=tolower(current_node)%>)
    <% } else {-%>
        <%=current_node%>
    <% } -%>
    <%=ifelse(i==length(cnode), ".", ",")%>
<% } -%>
<% } -%>

<% } else if(!single_report) { -%>
### <%=top_value_method%>:<%=partition_method%><%=mark%>
<% } -%>

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message-blank, echo = FALSE, message = NA}
message("-----------------------------------------------------------------")
```
<% } -%>
<% } -%>

<% 
if(is_hc) { -%>
```{r <%=chunk_prefix%>-message0, echo = FALSE, message = NA}
section_t1 = Sys.time()
message("* generating plots for node <%=node%> (<%=i_section%>/<%=n_section%>)")
```
<% } else { -%>
```{r <%=chunk_prefix%>-message0, echo = FALSE, message = NA}
section_t1 = Sys.time()
message("* generating plots for <%=top_value_method%>:<%=partition_method%> (<%=i_section%>/<%=n_section%>)")
```
<% } -%>

<% if(!single_report) { %>
The object with results only for a single top-value method and a single partitioning method 
can be extracted as:

```{r <%=chunk_prefix%>-rename}
<% if(is_hc) { -%>
res = res_rh["<%=node%>"]
<% } else { -%>
res = res_list["<%=top_value_method%>", "<%=partition_method%>"]
# you can also extract it by
# res = res_list["<%=top_value_method%>:<%=partition_method%>"]
<% } -%>
```
<% } -%>

A summary of `res` and all the functions that can be applied to it:

```{r <%=chunk_prefix%>-print-object}
res
```

`collect_plots()` function collects all the plots made from `res` for all `k` (number of subgroups)
into one single page to provide an easy and fast comparison between different `k`.

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message1, echo = FALSE, message = NA}
t1 = Sys.time()
message("  - collecting all plots (k = '<%=paste(all_k, collapse=', ')%>')", appendLF = FALSE)
```
<%}-%>

```{r <%=chunk_prefix%>-all-k, echo = FALSE}
all_k = res@k
```

```{r <%=chunk_prefix%>-collect-plots, fig.width = <%=fs*length(all_k)%>, fig.height = <%=fs*4%>, results = "hide"}
collect_plots(res)
```

The plots are:

- The first row: a plot of the eCDF (empirical cumulative distribution
  function) curves of the consensus matrix for each `k` and the heatmap of
  predicted classes for each `k`.
- The second row: heatmaps of the consensus matrix for each `k`.
- The third row: heatmaps of the membership matrix for each `k`.
- The fouth row: heatmaps of the signatures for each `k`.

All the plots in panels can be made by individual functions and they are
plotted later in this section.

`select_partition_number()` produces several plots showing different
statistics for choosing "optimized" `k`. There are following statistics:

- eCDF curves of the consensus matrix for each `k`;
- 1-PAC. [The PAC score](https://en.wikipedia.org/wiki/Consensus_clustering#Over-interpretation_potential_of_consensus_clustering)
  measures the proportion of the ambiguous subgrouping.
- Mean silhouette score.
- Concordance. The mean probability of fiting the consensus subgroup labels in all
  partitions.
- Area increased. Denote $A_k$ as the area under the eCDF curve for current
  `k`, the area increased is defined as $A_k - A_{k-1}$.
- Rand index. The percent of pairs of samples that are both in a same cluster
  or both are not in a same cluster in the partition of k and k-1.
- Jaccard index. The ratio of pairs of samples are both in a same cluster in
  the partition of k and k-1 and the pairs of samples are both in a same
  cluster in the partition k or k-1.

The detailed explanations of these statistics can be found in [the _cola_
vignette](https://jokergoo.github.io/cola_vignettes/cola.html#toc_13).

Generally speaking, higher 1-PAC score, higher mean silhouette score or higher
concordance corresponds to better partition. Rand index and Jaccard index
measure how similar the current partition is compared to partition with `k-1`.
If they are too similar, we won't accept `k` is better than `k-1`.

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message2, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - plotting various statistics for selecting best k", appendLF = FALSE)
```
<%}-%>

```{r <%=chunk_prefix%>-select-partition-number, results = "hide", fig.width = 10}
select_partition_number(res)
```

The numeric values for all these statistics can be obtained by `get_stats()`.

```{r <%=chunk_prefix%>-get-stats}
get_stats(res)
```

`suggest_best_k()` suggests the best $k$ based on these statistics. The rules are as follows:

- All $k$ with Jaccard index larger than 0.95 are removed because increasing
  $k$ does not provide enough extra information. If all $k$ are removed, it is
  marked as no subgroup is detected.
- For all $k$ with 1-PAC score larger than 0.9, the maximal $k$ is taken as
  the best $k$, and other $k$ are marked as optional $k$.
- If it does not fit the second rule. The $k$ with the maximal vote of the
  highest 1-PAC score, highest mean silhouette, and highest concordance is
  taken as the best $k$.

```{r <%=chunk_prefix%>-suggest-best-k}
suggest_best_k(res)
```

<% best_k = suggest_best_k(res)
opt_k = attr(best_k, "optional")
if(!is.null(opt_k)) { 
opt_k = gsub(",", ", ", opt_k) -%>
There is also optional best $k$ = <%=opt_k%> that is worth to check.
<% } -%>

Following is the table of the partitions (You need to click the **show/hide
code output** link to see it). The membership matrix (columns with name `p*`)
is inferred by
[`clue::cl_consensus()`](https://www.rdocumentation.org/link/cl_consensus?package=clue)
function with the `SE` method. Basically the value in the membership matrix
represents the probability to belong to a certain group. The finall subgroup
label for an item is determined with the group with highest probability it
belongs to.

In `get_classes()` function, the entropy is calculated from the membership
matrix and the silhouette score is calculated from the consensus matrix.


```{r <%=chunk_prefix%>-get-classes, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) {
if(inherits(res, "DownSamplingConsensusPartition")) {-%>
knitr_add_tab_item('get_classes(res, k = <%=k%>)', 'k = <%=k%>', prefix = '<%=chunk_prefix%>-get-classes', hide_and_show = TRUE)
<%} else {-%>
knitr_add_tab_item('cbind(get_classes(res, k = <%=k%>), get_membership(res, k = <%=k%>))', 'k = <%=k%>', prefix = '<%=chunk_prefix%>-get-classes', hide_and_show = TRUE)
<%}
}-%>
knitr_insert_tabs('<%=chunk_prefix%>-get-classes')
```

Heatmaps for the consensus matrix. It visualizes the probability of two
samples to be in a same group.

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message3, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - making consensus heatmaps (k = '<%=paste(all_k, collapse=', ')%>')", appendLF = FALSE)
```
<%}-%>

```{r <%=chunk_prefix%>-consensus-heatmap, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('consensus_heatmap(res, k = <%=k%>)', 'k = <%=k%>', prefix = '<%=chunk_prefix%>-consensus-heatmap')
<%}-%>
knitr_insert_tabs('<%=chunk_prefix%>-consensus-heatmap')
```

Heatmaps for the membership of samples in all partitions to see how consistent they are:

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message4, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - making membership heatmaps (k = '<%=paste(all_k, collapse=', ')%>')", appendLF = FALSE)
```
<%}-%>


```{r <%=chunk_prefix%>-membership-heatmap, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('membership_heatmap(res, k = <%=k%>)', 'k = <%=k%>', prefix = '<%=chunk_prefix%>-membership-heatmap')
<%}-%>
knitr_insert_tabs('<%=chunk_prefix%>-membership-heatmap')
```

As soon as the classes for columns are determined, the signatures
that are significantly different between subgroups can be looked for. 
Following are the heatmaps for signatures.

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message5, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - getting signatures (k = '<%=paste(all_k, collapse=', ')%>')", appendLF = FALSE)
```
<%}-%>

<% if(res@scale_rows) { %>
Signature heatmaps where rows are scaled:
<% } %>

```{r <%=chunk_prefix%>-signature, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('get_signatures(res, k = <%=k%>)', 'k = <%=k%>', opt = 'results = "hide"', prefix = '<%=chunk_prefix%>-get-signatures')
<%}-%>
knitr_insert_tabs('<%=chunk_prefix%>-get-signatures')
```

<% if(res@scale_rows) { %>

Signature heatmaps where rows are not scaled:

```{r <%=chunk_prefix%>-signature-no-scale, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('get_signatures(res, k = <%=k%>, scale_rows = FALSE)', 'k = <%=k%>', opt = 'results = "hide"', prefix = '<%=chunk_prefix%>-get-signatures-no-scale')
<%}-%>
knitr_insert_tabs('<%=chunk_prefix%>-get-signatures-no-scale')
```

<% } %>

Compare the overlap of signatures from different k:

```{r <%=chunk_prefix%>-signature_compare, results = "hide"}
compare_signatures(res)
```

`get_signature()` returns a data frame invisibly. To get the list of signatures, the function
call should be assigned to a variable explicitly. In following code, if `plot` argument is set
to `FALSE`, no heatmap is plotted while only the differential analysis is performed.

```{r <%=chunk_prefix%>-signature-no-run, eval = FALSE}
# code only for demonstration
tb = get_signature(res, k = ..., plot = FALSE)
```

An example of the output of `tb` is:

```
#>   which_row         fdr    mean_1    mean_2 scaled_mean_1 scaled_mean_2 km
#> 1        38 0.042760348  8.373488  9.131774    -0.5533452     0.5164555  1
#> 2        40 0.018707592  7.106213  8.469186    -0.6173731     0.5762149  1
#> 3        55 0.019134737 10.221463 11.207825    -0.6159697     0.5749050  1
#> 4        59 0.006059896  5.921854  7.869574    -0.6899429     0.6439467  1
#> 5        60 0.018055526  8.928898 10.211722    -0.6204761     0.5791110  1
#> 6        98 0.009384629 15.714769 14.887706     0.6635654    -0.6193277  2
...
```

The columns in `tb` are:

1. `which_row`: row indices corresponding to the input matrix.
2. `fdr`: FDR for the differential test. 
3. `mean_x`: The mean value in group x.
4. `scaled_mean_x`: The mean value in group x after rows are scaled.
5. `km`: Row groups if k-means clustering is applied to rows (which is done by automatically selecting number of clusters).

If there are too many signatures, `top_signatures = ...` can be set to only show the 
signatures with the highest FDRs:

```{r <%=chunk_prefix%>-signature-no-run2, eval = FALSE}
# code only for demonstration
# e.g. to show the top 500 most significant rows
tb = get_signature(res, k = ..., top_signatures = 500)
```

If the signatures are defined as these which are uniquely high in current group, `diff_method` argument
can be set to `"uniquely_high_in_one_group"`:

```{r <%=chunk_prefix%>-signature-no-run3, eval = FALSE}
# code only for demonstration
tb = get_signature(res, k = ..., diff_method = "uniquely_high_in_one_group")
```

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message6, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - making dimension reduction plots (k = '<%=paste(all_k, collapse=', ')%>')", appendLF = FALSE)
```
<%}-%>

<% 
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 which shows how samples are separated.

```{r <%=chunk_prefix%>-mds, results = "asis", echo = FALSE, include = TRUE}
<% for(k in all_k) { -%>
knitr_add_tab_item('dimension_reduction(res, k = <%=k%>, method = "<%=dr_method%>")', 'k = <%=k%>', prefix = '<%=chunk_prefix%>-dimension-reduction')
<%}-%>
knitr_insert_tabs('<%=chunk_prefix%>-dimension-reduction')
```

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message7, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message("  - collecting classifications for all k", appendLF = FALSE)
```
<%}-%>

Following heatmap shows how subgroups are split when increasing `k`:

```{r <%=chunk_prefix%>-collect-classes}
collect_classes(res)
```

<% if(has_known_anno) { -%>

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message8, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1)))); t1 = Sys.time()
message(qq("  - testing correlation of subgroups to known annotations"), appendLF = FALSE)
```
<%}-%>

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 <%=chunk_prefix%>-test-to-known-factors}
test_to_known_factors(res)
```

<% if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message9, echo = FALSE, message = NA}
t2 = Sys.time(); message(paste0(", ", gsub("^ +", "", format(t2 - t1))));
```
<%}-%>

<%} else {
if(n_cores == 1) { -%>
```{r <%=chunk_prefix%>-message9, echo = FALSE, message = NA}
message("")
```
<%} }-%>

If matrix rows can be associated to genes, consider to use `functional_enrichment(res,
...)` to perform function enrichment for the signature genes. See [this vignette](https://jokergoo.github.io/cola_vignettes/functional_enrichment.html) for more detailed explanations.


<% 
if(is_hc) { -%>
```{r <%=chunk_prefix%>-message10, echo = FALSE, message = NA}
section_t2 = Sys.time()
message(paste0("  - section node <%=node%> used in total ", gsub("^ +", "", format(section_t2 - section_t1))))
```
<% } else { -%>
```{r <%=chunk_prefix%>-message10, echo = FALSE, message = NA}
section_t2 = Sys.time()
message(paste0("  - section <%=top_value_method%>:<%=partition_method%> used in total ", gsub("^ +", "", format(section_t2 - section_t1))))
```
<% } -%>
