---
title: "chewieSnake report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
  html_document:
    toc: true
    toc_depth: 2
---

<style type="text/css">
.main-container {
  max-width: 3600px;
  margin-left: auto;
  margin-right: auto;
}
</style>

<style>
  tbody tr:hover {
  background: yellow;
} 

</style>


```{r setup, include=FALSE}
knitr::opts_chunk$set(out.width = '80%',fig.asp= 0.5,fig.align='center',echo=FALSE, warning=FALSE, message=FALSE, fig.height = 20, fig.width = 20, fig.align = "center")
options(markdown.HTML.header = system.file("misc", "datatables.html", package = "knitr"))

```


```{r load_packages, echo=FALSE}

suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(reshape)) # for converting matrix
suppressPackageStartupMessages(library(ggplot2)) # for plotting (which?)
suppressPackageStartupMessages(library(ape)) # read/write data
suppressPackageStartupMessages(library(DT)) # datatable 
suppressPackageStartupMessages(library(plotly)) # interactive plots/trees
suppressPackageStartupMessages(library(dendextend)) ##  get_nodes_attr


#library(phylocanvas)
do.phylocanvas <- F
# library(phylogram) # for import/export of trees
#library(ggtree) ## for tree plotting (which?)

# install.packages("magrittr")
# install.packages("reshape") # for converting matrix
# install.packages("ggplot2") # for plotting (which?)
# install.packages("ape")
# install.packages("DT") # datatable
# install.packages("dendextend") ## which functions actually?
# install.packages("phylogram") # for import/export of trees
# install.packages("plotly")
# install.packages("ggtree") ## for tree plotting (which?)


```


```{r define_Data, echo=FALSE}

# if flag manual == TRUE, specify paths per hand, otherwise via snakamake
manual <- T #F,T
#manual <- TRUE


if(manual){

  print("Warning: Manual execution")
  #workdir <- "/home/carlus/BfR/Projects/Pipeline_test/chewieSnake"
  #workdir <- "/cephfs/abteilung4/NGS/Databases/Salmonella/cgmlst"
  workdir <- "/cephfs/abteilung4/Projects_NGS/chewie_snake/Salmonella_test"
  allele_stats_file <- file.path(workdir, "cgmlst","allele_statistics.tsv")
  distance_matrix_file <- file.path(workdir, "cgmlst","distance_matrix.tsv")
  distance_matrix_simple_file <- file.path(workdir, "cgmlst","distance_matrix_simple.tsv")
  nwk_file  <- file.path(workdir, "cgmlst","grapetree_mstree.tre")

# parameters
exportpath <- file.path(workdir, "cgmlst", "exported_trees")
export <- T
distance_threshold <- 20

clustering.method <- "average" #"single"
#clustering_threshold_range_raw <- c(50,20,10,5,1)#opt$thresholds
clustering_threshold_range_raw <- "1,5,10,20,50,100,200,1000"

  
} else {
workdir <- snakemake@params[["workdir"]]  


allele_stats_file <- file.path(workdir, snakemake@input[["allele_stats"]])

distance_matrix_file <- file.path(workdir, snakemake@input[["distance_matrix"]])
distance_matrix_simple_file <- file.path(workdir, snakemake@input[["distance_matrix_simple"]])
nwk_file  <- file.path(workdir, snakemake@input[["nwk"]])


# params
#snakemake@params
exportpath <- file.path(workdir, snakemake@params[["exportpath"]])
export <- snakemake@params[["export"]]
#if(grepl("True",export, ignore.case = T)) export <- TRUE else export <- FALSE
distance_threshold <- snakemake@params[["distance_threshold"]]

clustering.method <- snakemake@params[["clustering_method"]]
clustering_threshold_range_raw <- snakemake@params[["threshold_range"]]
}


```

```{r load_data, echo=FALSE}



allele_stats <- read.delim(allele_stats_file, stringsAsFactors = F, header = T, sep = "\t")

distance_matrix <- read.delim(distance_matrix_file, stringsAsFactors = F, header = F, sep = " ")

distance_matrix_simple <- read.delim(distance_matrix_simple_file, stringsAsFactors = F, header = F, sep = " ")


nwk <- ape::read.tree(nwk_file)

samples <- distance_matrix$V1
```

```{r preprocess_data, echo=FALSE}

# re-format cluster distance matrix
rownames(distance_matrix) <- distance_matrix[,1]
distance_matrix <- as.matrix(distance_matrix[,-1])
colnames(distance_matrix) <- rownames(distance_matrix)

# re-order matrix
distance_matrix_clustered <- hclust(as.dist(distance_matrix))
distance_matrix <- distance_matrix[distance_matrix_clustered$order, distance_matrix_clustered$order]

# filter matrix: remove outliers
# outliers <- which(rowMeans(distance_matrix) > outlier_threshold)
# samples_outliers <- names(outliers)
# if(length(outliers) > 0 ){
#   distance_matrix <- distance_matrix[-outliers,-outliers]  
# }


# melt matrix
distance_matrix.m <- reshape2::melt(distance_matrix)
colnames(distance_matrix.m) <- c("Sample1","Sample2","Distance")


# procesing simple distance matrix

# re-format cluster distance matrix
rownames(distance_matrix_simple) <- distance_matrix_simple[,1]
distance_matrix_simple <- as.matrix(distance_matrix_simple[,-1])
colnames(distance_matrix_simple) <- rownames(distance_matrix_simple)

# re-order matrix
distance_matrix_simple_clustered <- hclust(as.dist(distance_matrix_simple))
distance_matrix_simple <- distance_matrix_simple[distance_matrix_simple_clustered$order, distance_matrix_simple_clustered$order]

# melt matrix
distance_matrix_simple.m <- reshape2::melt(distance_matrix_simple)
colnames(distance_matrix_simple.m) <- c("Sample1","Sample2","Distance")


```

# cluster report for analysis `r workdir` {.tabset}


## Overview

Last update on `r strsplit(as.character(file.info(distance_matrix_file)$mtime[1]), split = " ")[[1]][1]`.

```{r overview, echo=FALSE}

# number of clusters (need to compute before)



# new files 


# need keep track of files added date


# new clusters
# need file cluster old, or cluster_db with cluster number and date
# link to cluster?

# new matches
# for each cluster, show distance of new files

```


## Allele statistics


```{r allele_stats, echo=FALSE}

# allele stats
DT::datatable(allele_stats, filter = 'top',rownames= FALSE, escape = FALSE)


# more stats, viz


ggplot(allele_stats, aes(x=EXC)) + geom_histogram(binwidth = 10) + xlab("Number of exaxt matches")
ggplot(allele_stats, aes(x=LNF)) + geom_histogram(binwidth = 1) + xlab("Number of loci not found")
ggplot(allele_stats, aes(x=PLOT)) + geom_histogram(binwidth = 1) + xlab("Number of contig-tip loci (PLOT)")
ggplot(allele_stats, aes(x=NIPH)) + geom_histogram(binwidth = 1) + xlab("Number of possible paralogs")

#hist(allele_stats$EXC)
#hist(allele_stats$LNF)
#hist(allele_stats$PLOT)
#hist(allele_stats$NIPH)




# simple vs normal distance: difference only at larger allele differences
plot(distance_matrix_simple.m$Distance, distance_matrix.m$Distance)
lines(c(0,10000),c(0,10000),col=3)


Diff <- (distance_matrix_simple.m$Distance - distance_matrix.m$Distance)
relDiff <- (distance_matrix_simple.m$Distance - distance_matrix.m$Distance) / distance_matrix_simple.m$Distance


distance_matrix_simple.m$Distance[Diff < -50]

hist(Diff[Diff > -10])


distance_matrix_simple.m$Distance[Diff > -10]

Diff[distance_matrix_simple.m$Distance < 20]

```

### Abbreviations

*  EXC - alleles which have exact matches (100% DNA identity) with previously identified alleles

*  INF - inferred new alleles using Prodigal CDS predictions

*  LNF - loci not found. No alleles were found for the number of loci in the schema shown. This means that, for those loci, there were no BLAST hits or they were not within the BSR threshold for allele assignment.

* PLOT - possible loci on the tip of the query genome contigs (see image below). A locus is classified as PLOT when the CDS of the query genome has a BLAST hit with a known larger allele that covers the CDS sequence entirely and the unaligned regions of the larger allele exceeds one of the query genome contigs ends. This could be an artifact caused by genome fragmentation resulting in a shorter CDS prediction by Prodigal. To avoid locus misclassification, loci in such situations are classified as PLOT.

*  NIPH - non-informative paralogous hit (see image below). When ≥ 2 CDSs in the query genome match one locus in the schema with a BSR > 0.6, that locus is classified as NIPH. This suggests that such locus can have paralogous (or orthologous) loci in the query genome and should be removed from the analysis due to the potential uncertainty in allele assignment (for example, due to the presence of multiple copies of the same mobile genetic element (MGE) or as a consequence of gene duplication followed by pseudogenization). A high number of NIPH may also indicate a poorly assembled genome due to a high number of smaller contigs which result in partial CDS predictions. These partial CDSs my contain conserved domains that match multiple loci. This classification takes precedence over PLOT classification.
* NIPHEM - similar to NIPH classification (NIPH with exact match), but specifically referring to exact matches. Whenever > 1 CDS matches different alleles of the same locus with 100% DNA similarity during the first DNA sequence comparison, the NIPHEM tag is attributed. The loci classified as NIPHEM are included in NIPH statistics file column, but represent a distinct classification in the MLST profile.

    
* ALM - alleles 20% larger than length mode of the distribution of the matched loci (CDS length > (locus length mode + locus length mode * 0.2)) (see image below). This determination is based on the currently identified set of alleles for a given locus.
* ASM - similar to ALM but for alleles 20% smaller than length mode distribution of the matched loci (CDS length < (locus length mode - locus length mode * 0.2)).


See [here](https://github.com/B-UMMI/chewBBACA/wiki/2.-Allele-Calling) for more details.


## Simple allele distance table

```{r distance_table_simple, echo=FALSE}
distance_matrix_simple_noself.m <- distance_matrix_simple.m[distance_matrix_simple.m$Sample1 != distance_matrix_simple.m$Sample2,]

DT::datatable(distance_matrix_simple_noself.m, filter = 'top',rownames= FALSE, escape = FALSE)
# set default sorting

```


## Allele distance table

```{r distance_table, echo=FALSE}
distance_matrix_noself.m <- distance_matrix.m[distance_matrix.m$Sample1 != distance_matrix.m$Sample2,]

DT::datatable(distance_matrix_noself.m, filter = 'top',rownames= FALSE, escape = FALSE)
# set default sorting

```


## Simple allele distance matrix

```{r distance_matrix_simple, echo=FALSE}

#label_color <- ifelse(meta_selected$Source[match(colnames(matrix_reduced),meta_selected$ID)] == "human", "blue", "black")

p1 <- ggplot(distance_matrix_simple.m, aes(Sample1, Sample2)) +
  geom_tile(aes(fill = Distance)) + 
  geom_text(aes(label = round(Distance, 1)), size = 1) + # add distances to matrix
  scale_fill_gradient(low = "red", high = "white") +  
  theme(axis.text.x = element_text(angle = 90, vjust = 1, size = 8, hjust = 1),  axis.title.x = element_blank(),
        axis.title.y = element_blank()) + 
  ggtitle("Allele distance matrix") + 
  labs(fill = "Alleles", caption = "Allele distance matrix") + coord_fixed()

  # make interactive, zoom
  # plotly
  
p1

#plotly::ggplotly(p1)


a <- list(
  title = "Sample",
  showticklabels = TRUE,
  tickangle = 45
)


p2 <- plot_ly(x=distance_matrix_simple.m$Sample1,y=distance_matrix_simple.m$Sample2,z=distance_matrix_simple.m$Distance, type = "heatmap") %>%
layout(xaxis = a, yaxis = a, showlegend = TRUE)




p2


```

## Allele distance matrix

```{r distance_matrix, echo=FALSE}

#label_color <- ifelse(meta_selected$Source[match(colnames(matrix_reduced),meta_selected$ID)] == "human", "blue", "black")

p1 <- ggplot(distance_matrix.m, aes(Sample1, Sample2)) +
  geom_tile(aes(fill = Distance)) + 
  geom_text(aes(label = round(Distance, 1)), size = 1) + # add distances to matrix
  scale_fill_gradient(low = "red", high = "white") +  
  theme(axis.text.x = element_text(angle = 90, vjust = 1, size = 8, hjust = 1),  axis.title.x = element_blank(),
        axis.title.y = element_blank()) + 
  ggtitle("Allele distance matrix") + 
  labs(fill = "Alleles", caption = "Allele distance matrix") + coord_fixed()

  # make interactive, zoom
  # plotly
  
p1

#plotly::ggplotly(p1)


a <- list(
  title = "Sample",
  showticklabels = TRUE,
  tickangle = 45
)


p2 <- plot_ly(x=distance_matrix.m$Sample1,y=distance_matrix.m$Sample2,z=distance_matrix.m$Distance, type = "heatmap") %>%
layout(xaxis = a, yaxis = a, showlegend = TRUE)




p2


```

## Clustering

The clustering is based on the simple distance matrix.

```{r clustering, echo=FALSE}

# use only simple distance matrix

distance_matrix <- distance_matrix_simple


# add clustering, cluster-address
#clustering_threshold_range_raw <- trimws(clustering_threshold_range_raw, which = c("both"))
clustering_threshold_range <- as.numeric(strsplit(clustering_threshold_range_raw,"[ ,;]+")[[1]])
#clustering_threshold_range <- clustering_threshold_range_raw


dendro <- distance_matrix %>% as.dist %>% hclust(., method = clustering.method) %>% as.dendrogram 

# subclusters
subcluster_counts <- lapply(clustering_threshold_range, function(cut_threshold) cut(dendro, h = cut_threshold)) %>% sapply(., function(x) length(x$lower))
names(subcluster_counts) <- clustering_threshold_range

# initialize cluster_address_matrix
cluster_address_matrix <- matrix(data = NA, nrow = nrow(distance_matrix), ncol = length(clustering_threshold_range), dimnames = list( rownames(distance_matrix),rev(clustering_threshold_range)))


# compute cluster membership for all thresholds
for(cut_threshold in clustering_threshold_range) {
  dendro_cut <- cut(dendro, h = cut_threshold)
  for (subcluster in 1:length(dendro_cut$lower)){
    cluster_address_matrix[dendro_cut$lower[[subcluster]] %>% get_nodes_attr("label") %>% .[!is.na(.)],as.character(cut_threshold)] <- subcluster
  }
}

# re-order
cluster_address_matrix <- cluster_address_matrix[,as.character(sort(as.numeric(colnames(cluster_address_matrix)),decreasing = T))]


# convert to single address
cluster_address <- apply(cluster_address_matrix,1,function(x) paste(x, collapse = "."))


# table of cluster membership
cluster_address_matrix_augmented <- as.data.frame(cluster_address_matrix)
colnames(cluster_address_matrix_augmented) <- paste("threshold",colnames(cluster_address_matrix_augmented),sep = "_")
cluster_address_matrix_augmented$Sample <- rownames(cluster_address_matrix)

cluster_address_matrix_augmented[] <- lapply( cluster_address_matrix_augmented, factor) 

cluster_address_matrix_augmented <- cluster_address_matrix_augmented[,c(ncol(cluster_address_matrix_augmented),1:(ncol(cluster_address_matrix_augmented)-1))]

```

The allele distance matrix was hierarchically clustered using average linkage clustering and the subsequent clustering was divided into different sub-clustered at the chosen thresholds `r paste(clustering_threshold_range,collape=",") `. At each threshold, samples are assigned to a cluster - resulting in a cluster member number. Searching the following table provides information which samples cluster together at a chosen allele threshold.

The combined cluster member numbers at all chosen threshold correspond to the cluster address.

Note that the cluster member numbers (cluster address) may be subject to change every time the clustering is run again!

The entire tree as well as the individual trees can be exported and visualized - together with relevant metadata - in interactive tools such as grapetree, phandango etc. The files were exported to the directory `r exportpath`


```{r visualize_clustering}

datatable(cluster_address_matrix_augmented, caption = "Cluster membership", filter = 'top',rownames= FALSE, escape = FALSE)

knitr::kable(data.frame(cbind("cluster threshold" = names(subcluster_counts), "Cluster count" = subcluster_counts)),row.names = F)

#plot(dendro, horiz = T, xlab = "Clustering threshold", ylab = "Samples", main = "Tree resulting from clustering analysis")
#abline(v= clustering_threshold_range, col = rainbow(length(clustering_threshold_range)))



```




### Details of clustering analysis using a cluster threshold of `r distance_threshold`

In the following, the clustering analysis is re-evaluated for the allele threshold of `r distance_threshold`. The first dendrogram provides an overview about the global clustering followed by dendrograms for every sub-cluster (exluding singletons).

```{r cluster_viz_details}

#color_value <- subcluster_counts[as.character(distance_threshold)]
color_value <- 3
dendro %>% set("labels_cex", 0.5) %>% set("labels_col", value = rainbow(color_value), h=distance_threshold) %>% set("branches_k_color", value = rainbow(color_value), h = distance_threshold) %>% 
  plot(main = paste("Tree resulting from clustering analysis"), sub = paste("Colored by using cluster threshold of",distance_threshold), horiz = T, xlab = "Clustering threshold", ylab = "Samples")
abline(v= distance_threshold, col = 8 , lwd = 3)


#TODO nicer tree with ggtree?
# TODO add cluster numbers to the right of each cluster?


dendro_cut <- cut(dendro, h = distance_threshold)
clusters_notplotted <- c()

for (subtree in 1:length(dendro_cut$lower)){  
  dend <- dendro_cut$lower[[subtree]]
  
  cluster_size <- dend %>% get_nodes_attr("label") %>% (function(x) x[!is.na(x)]) %>% length
  if(cluster_size > 1){
    plot(dend, horiz = T, main = paste("Subtree for cluster",subtree))
  } else {
    clusters_notplotted <- c(clusters_notplotted,subtree)
  }
}

# unplotted clusters


```


The following clusters - only containing singletons - were not plotted: `r paste(clusters_notplotted, collapse = ",")`

```{r export_clustering}

if(export){

  
  dir.create(exportpath, showWarnings = F)


  
# export clustering
ape::write.tree(as.phylo(dendro), file = file.path(exportpath,"clustering_global.tre"))


# export cluster memberships
write.table(cluster_address_matrix_augmented, file = file.path(exportpath, "cluster_addresses.tsv"), sep = "\t", col.names = sub("Sample","ID",colnames(cluster_address_matrix_augmented)), row.names = F, quote = F)

# export subtrees

for (subtree in 1:length(dendro_cut$lower)){  
  dend <- dendro_cut$lower[[subtree]]
  treefile_sub <- file.path(exportpath,paste0("clustering_subtree_",subtree,".tre"))
  cluster_size <- dend %>% get_nodes_attr("label") %>% (function(x) x[!is.na(x)]) %>% length
  if(cluster_size > 1){
    #phylogram::write.dendrogram(dend, file = treefile_sub, append = FALSE, edges = TRUE)
    #ape::write.tree(dend.phylo, file = treefile_sub) # not working here

  } 
}


}

```


## Phylogenetic tree
The following phylogenetic tree is based on grapetrees minimum spanning tree.

Note that you can visualize the tree more interactively and combine it with metadata using tools such as grapetree and phandango. 

### Simple 
```{r trees, echo=FALSE}

#p_phyl <- ggtree::ggtree(nwk) + ggtree::geom_text2(aes(subset=!isTip, label=node), hjust=-.3) + ggtree::geom_tiplab()
#p_phyl

plot(nwk)

# p_phyl <- ggplot(nwk)
# 
# ggplotly(p_phyl)


```


## Links to files

All data is available at `r workdir`.

The exported clustering files are in `r exportpath`

```{r file_info}



file_timestamps <- data.frame(
  name=c(
"distance matrix",
"simple distance matrix",
"Minimum spanning tree"
  ),
  file=c(
distance_matrix_file,
distance_matrix_simple_file,
nwk_file
)
)

file_timestamps$Link <- paste0("<a href=",file_timestamps$file,">",file_timestamps$name,"</a>")

knitr::kable(file_timestamps, caption = "Overview of files used for this report and their modification date")
  

#exportpath
 if(export){
   file_timestamps_2 <- data.frame(
  name=list.files(exportpath, full.names = F),
  file= list.files(exportpath, full.names = T))

   file_timestamps_2$Link <- paste0("<a href=",file_timestamps_2$file,">",file_timestamps_2$name,"</a>")

   
      knitr::kable(file_timestamps_2, caption = "Overview of files related to clustering")
 }
  


```
