---
title: "cgMLST report from joined allele database"
date: "`r Sys.time()`"
output:
  html_document:
    toc: true
    toc_depth: 2
editor_options: 
  chunk_output_type: console
---

<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}

# warings as they occur
options(warn=1)


# warnings off
#options(warn=-1)

suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(reshape2)) # 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
suppressPackageStartupMessages(library(RColorBrewer)) ## for color picking
#suppressPackageStartupMessages(library(ggtree)) ## nice trees, which ?



# warnings on
#options(warn=0)


```

```{r viz_parameters, echo=FALSE}
param_color_thr = c(0,1,5,10,20)
#param_color_thr = c(20,10,5,1,0)

bad_allele_threshold <- 0.05
bad_allele_threshold2 <- 0.1
recency_threshold <- 14

min_diff_filter <- T # if TRUE then filter cluster table on min_diff values


```

```{r define_Data, echo=FALSE}

#debug_mode <- T # params from file report_parameters
debug_mode <- F # params from snakemake

if(debug_mode){
  warning("Calling parameters from file report_parameters.R")
  source("parameters_report_joined.R")
  #source("/home/carlus/BfR/Snakemake/chewieSnake/scripts/parameters_report_joined.R")
} 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"]])
  # nwk_file  <- file.path(workdir, snakemake@input[["nwk"]])

  allele_stats_file <- snakemake@input[["allele_stats"]]
  distance_matrix_file <- snakemake@input[["distance_matrix"]]
  nwk_file  <- snakemake@input[["nwk"]]

    
  # read sender files
  # sample sender
  sender_info_file  <- snakemake@input[["sender_info"]]
  
  # timestamps  file 
  sample_timestamps_file <- snakemake@input[["timestamps"]]
  
  # cluster information
  cluster_information_file <- snakemake@input[["clustering_info"]]
  
  # orphan information
  orphan_information_file <- snakemake@input[["orphan_info"]]
  
  # 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
  
  parameters <- snakemake@params[["parameters"]]
  
  distance_threshold <- snakemake@params[["distance_threshold"]]
  clustering_method <- snakemake@params[["clustering_method"]]

  mapping_sample2serovar.file <- snakemake@params[["mapping_sample2serovar"]]
    
  sample2serovar.file <- snakemake@params[["sample2serovar"]]
  
  species_acronym <- snakemake@params[["species_shortname"]]
    
  
      #clustering_threshold_range_raw <- snakemake@params[["threshold_range"]]
  
  reduce_output <- F
  distance_limit <- 50
  
  log <- file(snakemake@log[[1]], open="wt")
  
  # redirect output to log file
  sink(log)
  sink(log, type="message")
  
  # define function file
  functions_file <- file.path(snakemake@params[["functions_file"]],"scripts/functions.R")
  

}


# define additional output

cluster_summary_file <- file.path("merged_db", "cluster_summary.tsv")

clustering_intercluster.file <- file.path("merged_db", "clustering_intercluster.tre")
#distancematrix_intercluster.file <- file.path(workdir,"distancematrix_intercluster.tsv")
# orphan_samples

```


```{r load functions}

source(functions_file)

```

```{r load_data, echo=F}

# load allele qc data
allele_stats <- read.delim(allele_stats_file, stringsAsFactors = F, header = T, sep = "\t", col.names = c("sample","EXC","INF","LNF","PLOT","NIPH","ALM","ASM"))

# load distance matrix
#distance_matrix <- read.delim(distance_matrix_file, stringsAsFactors = F, header = F, sep = " ")
distance_matrix <- read_distance_matrix(distance_matrix_file, sep=" ", header = F)

# load timing data
sample_timestamps <- read.delim(sample_timestamps_file, stringsAsFactors = F, header = F, sep = "\t", col.names = c("Sample","Timestamp"))

# load sender info
sender_info <- read.delim(sender_info_file, stringsAsFactors = F, header = T, sep = "\t", col.names = c("Sample","Sender"))

# load clustering info
samples_in_clusters <- read.delim(cluster_information_file, stringsAsFactors = F)

# load orphan information
samples_orphans <- read.delim(orphan_information_file, stringsAsFactors = F)

# load ms tree
nwk <- ape::read.tree(nwk_file)

# infer sample names
#samples <- distance_matrix$V1
samples <- rownames(distance_matrix)

```


```{r preprocess_data, echo=FALSE}

# export distance matrix
distance_matrix_out <- file.path(workdir, "merged_db", "allele_distance_matrix.tsv") #exportpath
write.table(distance_matrix, file = distance_matrix_out, sep="\t", quote = F, row.names = T, col.names = NA)


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

# further parameters
if(nrow(allele_stats)>0){
  locus_count <- sum(allele_stats[1,-1])
  distance_limit <- floor(locus_count/2)
} else {
  locus_count <- NA
  distance_limit <- 1000
}

```



```{r compute_cluster_summary}
# example  cluster_number <- 15

# get all senders
senders <- unique(sender_info$Sender)

# unique cluster names
clusters <- unique(samples_in_clusters$cluster_name)
clusters_size <- table(samples_in_clusters$cluster_name)

#myname <- "Antileon"
#myname <- "Palaephatus"
cluster_summary_list <- lapply(sort(clusters), function(myname){

  cluster_information <- samples_in_clusters[samples_in_clusters$cluster_name == myname,]
  # cluster names and numbers
  cluster_name = cluster_information$cluster_name[1]
  cluster_representativesample = cluster_information$representative_sample[1]

# no of samples in cluster
count_samples <- nrow(cluster_information)
  
# sender count
  count_senders = sapply(senders, function(sender) sum(cluster_information$Sender ==sender) )

# no of recent samples per partner
  timestamp_mostrecent_sender = do.call(c,lapply(senders, function(sender) sort(cluster_information$Timestamp[cluster_information$Sender ==sender], decreasing = T)[1] ))
    names(timestamp_mostrecent_sender) <- senders

  # age difference
  age_mostrecent_sender <- as.numeric(difftime(Sys.Date(), timestamp_mostrecent_sender, units = "day"))
    
    
  # no of recent samples in cluster
  timestamp_mostrecent <- sort(cluster_information$Timestamp, decreasing = T )[1]
  age_mostrecent <- as.numeric(difftime(Sys.Date(), timestamp_mostrecent, units = "day"))
  timestamp_mostancient <- sort(cluster_information$Timestamp, decreasing = F )[1]
  
  
  # min_diff min_same

  # subset distance_matrix
  distance_matrix_cluster <- distance_matrix[cluster_information$sample,cluster_information$sample]
  
  distance_matrix_cluster.m <- reshape2::melt(distance_matrix_cluster)
  colnames(distance_matrix_cluster.m) <- c("Sample1","Sample2","Distance")
  # 
  distance_matrix_cluster_noself.m <- distance_matrix_cluster.m[distance_matrix_cluster.m$Sample1 != distance_matrix_cluster.m$Sample2,]
  # 
  # # add information, (how to display?)
  distance_matrix_info.m <- merge(distance_matrix_cluster_noself.m,cluster_information[,c("sample","Sender")], by.x = "Sample1",by.y = "sample")
  distance_matrix_info.m <- merge(distance_matrix_info.m,cluster_information[,c("sample","Sender")], by.x = "Sample2",by.y = "sample", suffixes = c("_1","_2"))
  
  if(length(unique(distance_matrix_info.m$Sender_1)) == 1){
  min_diff <- NA
  which_min_diff <- NA
} else {
    distance_matrix_info.m_diff <- distance_matrix_info.m[distance_matrix_info.m$Sender_1 != distance_matrix_info.m$Sender_2,]
    min_diff <- min(distance_matrix_info.m_diff$Distance)
    whichmin <- which.min(distance_matrix_info.m_diff$Distance)
    which_min_diff <- paste(sort(unlist(distance_matrix_info.m_diff[whichmin,c("Sender_1","Sender_2")])),collapse = "-")
}
  
# minsame
  # min same global
if(length(distance_matrix_info.m$Distance[distance_matrix_info.m$Sender_1 == distance_matrix_info.m$Sender_2]) == 0){
  min_same <- NA
  which_min_same <- NA
} else {
  distance_matrix_info.m_same <- distance_matrix_info.m[distance_matrix_info.m$Sender_1 == distance_matrix_info.m$Sender_2,]
  
  min_same <- min(distance_matrix_info.m_same$Distance)
  whichmin2 <- which.min(distance_matrix_info.m_same$Distance)
  which_min_same <- distance_matrix_info.m_same[whichmin2,"Sender_1"]
}
  

  # data.frame with all info per cluster
cluster_summary <- data.frame(
           cluster_name = cluster_name, 
           representative_sample = cluster_representativesample, 
           count_samples = count_samples, 
           timestamp_mostrecent = timestamp_mostrecent, 
           age_mostrecent = age_mostrecent, 
           timestamp_mostancient = timestamp_mostancient,
           min_diff = min_diff,
           which_min_diff = which_min_diff,
           min_same = min_same
  )

  # need to add vectors by element in order to keep them in single row AND in date format
  cluster_summary_plus <- cluster_summary
  for(i in 1:length(count_senders)){
    # count
    myname=paste("count",names(count_senders)[i], sep = "_")
    cluster_summary_plus <- cbind(cluster_summary_plus,newname=count_senders[i])  
    colnames(cluster_summary_plus)[colnames(cluster_summary_plus) == "newname"] <- myname
    # timestamps
    myname2=paste("mostrecent",names(count_senders)[i], sep = "_")
    cluster_summary_plus <- cbind(cluster_summary_plus,newname2=timestamp_mostrecent_sender[i])  
    colnames(cluster_summary_plus)[colnames(cluster_summary_plus) == "newname2"] <- myname2
    # age  
    myname3=paste("age_mostrecent",names(count_senders)[i], sep = "_")
    cluster_summary_plus <- cbind(cluster_summary_plus,newname3=age_mostrecent_sender[i])  
    colnames(cluster_summary_plus)[colnames(cluster_summary_plus) == "newname3"] <- myname3
  }

  return(cluster_summary_plus)
  
}) # loop over all cluster_numbers


# convert list to data frame
cluster_summary_df <- do.call(rbind,cluster_summary_list)

# add epi_clustername
# Simple approach fails if more than one external cluster is associated to sample
#cluster_extra_info <- unique(samples_in_clusters[,c("cluster_name","external_cluster_name","representative_sample_externalcluster")])

# handle multiple matches 
cluster_extra_info <- do.call(rbind,lapply(unique(samples_in_clusters$cluster_name), function(cluster_name){
  samples_in_clusters.tmp <- samples_in_clusters[samples_in_clusters$cluster_name == cluster_name,]
  external_cluster_name <-  paste(unique(samples_in_clusters.tmp$external_cluster_name), collapse = ";" ) 
  
  representative_sample_externalcluster <- paste(unique(samples_in_clusters.tmp$representative_sample_externalcluster), collapse = ";" ) 
  
  return(data.frame(cluster_name = cluster_name,external_cluster_name = external_cluster_name,representative_sample_externalcluster = representative_sample_externalcluster))
  
  
}))

# add serovar info if available
if (any(colnames(samples_in_clusters) == "serovar")){
  # merge
  serovar_info <- unique(samples_in_clusters[,c("cluster_name","serovar")])

  cluster_extra_info <-  merge(x=cluster_extra_info,y = serovar_info,by.x="cluster_name",by.y="cluster_name")

  }

# START DEBUG

# count_unique_subclusters <- as.data.frame(t(sapply(clusters, function(myname){
#   #tmp <- as_tibble(samples_in_clusters[samples_in_clusters$cluster_name == myname,]) # MOD
#   tmp <- samples_in_clusters[samples_in_clusters$cluster_name == myname,] # OLD
# 
#     count_unique_subclusters.tmp <- apply(tmp[,grep("cluster_name_",colnames(tmp))],2,function(x) length(unique(x)) )
#   return(count_unique_subclusters.tmp)  
# 
# })))
# 
# colnames(count_unique_subclusters) <- sub("cluster_name_","subcluster_count_",colnames(count_unique_subclusters))
# 
# # add names
# #count_unique_subclusters$cluster_name <- clusters
# 
# # END DEBUG

# dummy until fixed
#count_unique_subclusters <- data.frame(cluster_name=clusters,subcluster_count=rep("NA",length(clusters)))

# add counts to extra info
# cluster_summary_df <- merge(x=cluster_summary_df,y=count_unique_subclusters) # TODO include when above is fixed

# add extra info
cluster_summary_df <- merge(x=cluster_summary_df,y=cluster_extra_info, by.x = "cluster_name", by.y = "cluster_name", all.x = T, all.y = F)

# add link
#link2subreport <- 
#  merged_db/clustering/Straton/clusterreport.html
  link_table <- do.call(c,lapply(sort(clusters),function(myname){
  #report <- file.path("..","merged_db","clustering",myname,"clusterreport.html") # relative
  report <- file.path("clustering",myname,"clusterreport.html") # relative
  #report <- file.path(workdir,"merged_db","clustering",myname,"clusterreport.html") # absolute

  report <- paste0("<a href=",report,">","Cluster_report","</a>")
  
  return(report)
}))
  
  
  # correct order
  cluster_summary_df$Details <- link_table
  #TODO check problem with different row numbers: related to double names
  #nrow(cluster_summary_df)
  #cluster_summary_df$external_cluster_name[which(duplicated(cluster_summary_df$cluster_name))]

  if( any(colnames(cluster_summary_df) == "serovar") ) {
    
    cluster_year <- sapply(as.character(cluster_summary_df$timestamp_mostancient), function(x) strsplit(x,"-")[[1]][1])
    
    cluster_long_name <- paste(species_acronym,cluster_summary_df$serovar,cluster_year,cluster_summary_df$cluster_name, sep = "_")
    cluster_summary_df$cluster_name_long <- cluster_long_name
    
    
    other_columns <- setdiff(colnames(cluster_summary_df), c("cluster_name","serovar","cluster_name_long"))
    
    cluster_summary_df <- cluster_summary_df[,c("cluster_name","serovar","cluster_name_long",other_columns)]
    
    
  }
  

# replace "_" by spaces in column names
colnames(cluster_summary_df) <- gsub("_"," ",colnames(cluster_summary_df))


```




```{r infer_exectutor}

# infer executor
executor <- Sys.info()["user"]

```

---
author: `r paste0(executor)`
---

# cgMLST report for joined analysis {.tabset}


User `r unname(Sys.info()["user"])` executed the pipeline.

## Overview


```{r overview_stats, echo=FALSE}

# Quality

# check if allele_stats empty
if(nrow(allele_stats) == 0){
  bad_allele_fraction <- NA
  good_allele_fraction <- NA
  bad_samples <- NA
  bad_sample_count <- NA
  
  #allele_stats <- data.frame(allele_stats[,1],good_allele_fraction=round(good_allele_fraction,2),bad_allele_fraction=round(bad_allele_fraction,2),allele_stats[,-1])
#colnames(allele_stats)[1:3] <- c("Sample","Fraction of\nloci found","Fraction of\nmissing loci")

  
} else {

bad_allele_fraction <- rowSums(allele_stats[,-c(1,2,3)])/rowSums(allele_stats[,-1])
good_allele_fraction <- 1 - bad_allele_fraction
bad_samples <- allele_stats[which(bad_allele_fraction > bad_allele_threshold),1]
bad_sample_count <- sum(bad_allele_fraction > bad_allele_threshold)

# add quality summary to allele_stats

allele_stats <- data.frame(allele_stats[,1],good_allele_fraction=round(good_allele_fraction,2),bad_allele_fraction=round(bad_allele_fraction,2),allele_stats[,-1])
colnames(allele_stats)[1:3] <- c("Sample","Fraction of\nloci found","Fraction of\nmissing loci")

    
}



# recent updates

recent_clusters_idx <- which(cluster_summary_df$`age mostrecent` < recency_threshold)

```


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

* Database contains `r length(samples)` samples.

* `r bad_sample_count` samples were of bad quality (having more than `r bad_allele_threshold * 100` per cent missing or dubiously called alleles ), see __Allele statistics__ for details. Bad samples: `r bad_samples`

* recent updates (last `r recency_threshold` days) for clusters: `r if(length(recent_clusters_idx) > 0) {paste(cluster_summary_df[recent_clusters_idx,"cluster name"], collapse = ",")} else {"None"}`




```{r partner clusters}
## Partner matches

cluster_partner_matrix <- matrix(nrow = length(senders),ncol=length(senders))
colnames(cluster_partner_matrix) <- senders
rownames(cluster_partner_matrix) <- senders

cluster_partner_matrix_matchcount <- cluster_partner_matrix

# find matches per cluster
cluster_partnermatches <- do.call(rbind,lapply(clusters,function(cluster) {
  
  data_incluster <- samples_in_clusters[samples_in_clusters$cluster_name == cluster,]
  links <- table(data_incluster$Sender)
  
  sender_match <- sapply(senders, function(sender){
    any(data_incluster$Sender == sender)
  })
  return(sender_match)
}))


# fill matrix with sender combinations
for (sender in senders){
  for (sender2 in senders){
    cluster_partner_matrix[sender, sender2] <- sum(cluster_partnermatches[,sender] & cluster_partnermatches[,sender2])
  }}


#  How many samples match between each sender
cluster_partnermatches_matches <- do.call(rbind,lapply(clusters,function(cluster) {
  
  #data_incluster <- clusters_membership[clusters_membership$x == cluster,] # VOID
  data_incluster <- samples_in_clusters[samples_in_clusters$cluster_name == cluster,]
  links <- table(data_incluster$Sender)
  
  sender_match <- sapply(senders, function(sender){
    sum(data_incluster$Sender == sender)
  })
  return(sender_match)
}))



# fill matrix with sender combinations, sum of matching samples
for (sender in senders){
  for (sender2 in senders){
    cluster_partner_matrix_matchcount[sender, sender2] <- sum(cluster_partnermatches[,sender],cluster_partnermatches[,sender2])
  }}


```


```{R color function}
#### Color coding
senders_color <- brewer.pal(length(senders), "Dark2") #"RdYlBu","RdBu"
names(senders_color) <- senders


  colorize <- function(x, color) {
    if (knitr::is_latex_output()) {
      sprintf("\\textcolor{%s}{%s}", color, x)
    } else if (knitr::is_html_output()) {
      sprintf("<span style='color: %s;'>%s</span>", color, 
              x)
    } else x
  }

  
color14="red"
color30="orange"
color90="pink"

  
```


```{r more_partner_computations}

sample_info <- merge(sender_info,sample_timestamps, by.x = "Sample", by.y = "Sample", all.x = T)

```


```{r data_overview}

sender_table <- table(sender_info$Sender)
sender_df <- data.frame(sender=names(sender_table),count=sender_table)

```


#### Provided samples per partner

```{r samples_per_partner, fig.width=10,fig.height=5}

p1<-   ggplot(data=sender_df, aes(x=sender, y=count.Freq, fill = sender)) +
 geom_bar(stat="identity") + coord_flip() + ylab("Number of provided samples") + xlab("Partner") +     scale_fill_manual(values=senders_color) # Define colors

# monocolor version
#p1<-ggplot(data=sender_df, aes(x=sender, y=count.Freq)) +
#  geom_bar(stat="identity") + coord_flip() + ylab("Number of provided samples") + xlab("Partner")


#p1 # static plot

# interactive plotly
ggplotly(p = p1)


```

#### Provided samples per date

```{r samples_per_date, fig.width=10,fig.height=5}
# find number of samples per date and sender
sample_info_table <- table(Date=sample_info$Timestamp,Sender=sample_info$Sender)

# convert to dataframe
sample_info_table_df <- as.data.frame(sample_info_table)
sample_info_table_df$Date2 <- as.Date(as.character(sample_info_table_df$Date))

# make barplot
p2<-ggplot(data=sample_info_table_df, aes(x=Date2, y=Freq, fill = Sender)) +
  geom_bar(stat="identity") + xlab("Date (of analysis)") + ylab("Number of samples") +   scale_x_date(date_labels ="%b %y", date_breaks = "2 month") +     scale_fill_manual(values=senders_color) # Define colors

# simple ggplot
#p2

# interactive plotly
ggplotly(p = p2)

```


### Matches between partners

```{r print_cluster_partners}

# results
# how many clusters have matches
knitr::kable(cluster_partner_matrix, caption = "Number of clusters that match beteen partners") 

# how many samples have matches in same cluster
knitr::kable(cluster_partner_matrix_matchcount, caption = "Number of samples with matches in same cluster")  

```


## Cluster summary

### Cluster summary

Shown is a summary of each cluster (containing at least 2 samples within allele distance `r distance_threshold`).

* You can identify clusters of interest by searching for recent additions of samples, counts per sending institution, etc. and a combination thereof
* You can check for updates of a specific cluster by searching for number, name or representative sample.
* More information about samples in each cluster can be inspected in the table __Samples in clusters__ below or in tab [Cluster details](#cluster-details)


__Column desciption__

* Cluster name: stable naming scheme (ancient greek writers)
* Serovar: The serovar (assigned to all samples in a cluster, where available)
* Cluster name long: Combination of cluster information elements, {species}_{serovar}_{year_of_oldest_sample}_{cluster_name} 
* Representative sample: Oldest sample in cluster, if more than one has same date, the first sample in alphabetical order is chosen (this is supposed to be a rather stable number)
* timestamp_mostrecent, mostrecent_*: Date when most recent sample was analysed
* timestamp_mostancient: Date of analysis of most ancient sample in cluster sample was analysed
* age: Number of days since most recent sample was analysed
* min_diff: Minimum allele distance between samples from different senders
* which_min_diff: Which sender combination the min_diff value originates from
* min_same: Minimum allele distance between samples from same sender
* external_cluster_name: clusters that match to representative sample of externally defined cluster (e.g. EPI-cluster)
* representative_sample_externalcluster: representative sample of externally defined cluster (e.g. EPI-cluster)
* Details: Link to cluster report with more details on cluster

```{r print_cluster_summary}


if(min_diff_filter){
  max_min_diff <- max(cluster_summary_df$`min diff`, na.rm = T)
  min_diff_search <- paste0("0 ... ",max_min_diff - 0.01)
  myColSearch <- list(NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, list(search = min_diff_search), NULL )
} else {
  myColSearch <- NULL  
}


DT::datatable(cluster_summary_df, filter = 'top',rownames= FALSE, escape = FALSE, 
          extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
    options = list(
                dom = 'BRrltpi',
                autoWidth=FALSE,
                order = list(list(4, 'asc')),
                searchCols = myColSearch,
#                search = list(regex = FALSE, caseInsensitive = FALSE, search = "BfR-RKI"),
                scrollX = TRUE,
                scrollY = TRUE,
                #fixedColumns = TRUE,
                lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                #ColReorder = TRUE,
                buttons =
                  list(
                    'copy',
                    'print',
                    list(
                      extend = 'collection',
                      buttons = c('csv', 'excel', 'pdf'),
                      text = 'Download'
                    ),
                    I('colvis')
                  )
              )) %>%
  formatRound(columns=grep("age",colnames(cluster_summary_df), value = T), digits=0)

#    formatRound(columns=c("age mostrecent",     "age mostrecent BfR", "age mostrecent LGL", "age mostrecent RKI"), digits=0)




```


### Samples in clusters

Shown is a table of all samples and their cluster association. Samples that are not found within an allele distance of `r distance_threshold` are termed _Orphans_.

__Column desciption__

* Sample: Sample name
* Sender: Information about the sending organization
* Timestamp: Time of cgMLST analysis
* Cluster_name: stable cluster nomenclature for clustering at an allele distance of `r distance_threshold` (ancient greek writers)
* Representative_sample: Oldest sample in cluster, if more than one has same date, the first sample in alphabetical order is chosen (this is supposed to be a rather stable number)
* external_cluster_name: samples that match to representative sample of externally defined cluster (e.g. EPI-cluster) within a distance threshold of  `r distance_threshold`
* representative_sample_externalcluster: representative sample of externally defined cluster (e.g. EPI-cluster)
* Cluster_name_10,Cluster_name_3: stable cluster nomenclature for clustering at distance 10,3, etc. (numeric or greek letter)
* cluster_code: Combination of the different cluster names at different allele distance thresholds: `r distance_threshold`.10.3

```{R samples_in_clusters}

samples_in_clusters.print <- samples_in_clusters
colnames(samples_in_clusters.print) <- gsub("_"," ",colnames(samples_in_clusters.print))

DT::datatable(samples_in_clusters.print, filter = 'top',rownames= FALSE, escape = FALSE, 
          extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
    options = list(
                dom = 'BRrltpi',
                autoWidth=FALSE,
                order = list(list(3, 'desc')),
                scrollX = TRUE,
                scrollY = TRUE,
                fixedColumns = TRUE,
                lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                ColReorder = TRUE,
                buttons =
                  list(
                    'copy',
                    'print',
                    list(
                      extend = 'collection',
                      buttons = c('csv', 'excel', 'pdf'),
                      text = 'Download'
                    ),
                    I('colvis')
                  )
              ))
```

## Orphans

List of orphan samples (not related to any other sample in dataset) and their minimum distance to the cluster's representative samples.

Note that the orphan numbers are not stable and may change.


```{R distance to clusters}
# distance to cluster

orphan_neighbours <-  do.call(rbind,lapply(samples_orphans$sample, function(mysample) {
   distance_matrix_sub <- distance_matrix[mysample, rownames(distance_matrix) %in% cluster_summary_df$`representative sample`]
   mindist <- min(distance_matrix_sub)
   bestsample <- names(which.min(distance_matrix_sub))
   bestname <- as.character(cluster_summary_df$`cluster name`[cluster_summary_df$`representative sample` == bestsample])
   
   data.frame(sample = mysample, closest_cluster = bestname, closest_representative_sample = bestsample, mindist = mindist)
   
 }))

if (is.null(orphan_neighbours)){
  orphan_neighbours <- as.data.frame(matrix(nrow=0,ncol = 4))
  colnames(orphan_neighbours) <-  c("sample", "closest_cluster", "closest_representative_sample", "mindist")
  
}

 
# add serovar info where available

if (file.info(sample2serovar.file)$size != 0) {
#if (file.exists(sample2serovar.file)){
  sample2serovar <- read.delim(sample2serovar.file, stringsAsFactors = F, header = F, col.names = c("sample","serovar"))

  samples_orphans <- merge(samples_orphans,sample2serovar, by.x = "sample", by.y = "sample", all.x = T)
  
}

# add neighbor info ---

samples_orphans <- merge(samples_orphans,orphan_neighbours, by.x = "sample", by.y = "sample")

# plot interactive table

DT::datatable(samples_orphans, filter = 'top',rownames= FALSE, escape = FALSE, 
          extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
    options = list(
                dom = 'BRrltpi',
                autoWidth=FALSE,
                scrollX = TRUE,
                fixedColumns = TRUE,
                lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                ColReorder = TRUE,
                buttons =
                  list(
                    'copy',
                    'print',
                    list(
                      extend = 'collection',
                      buttons = c('csv', 'excel', 'pdf'),
                      text = 'Download'
                    ),
                    I('colvis')
                  )
              ))


```

The distance of each orphan sample to any of the cluster representative samples is shown in section _Distance from samples to clusters_.

## Inter-cluster relation

Shown here are the distances between representative samples of each cluster.

```{r global picture}

# subset distance matrix to representative clusters

samples_representative <-  sapply(clusters, function(myname){
  samples_in_clusters$representative_sample[samples_in_clusters$cluster_name == myname][1]
})

distance_matrix_representativesamples <- distance_matrix[rownames(distance_matrix) %in% samples_representative,rownames(distance_matrix) %in% samples_representative]

# rename to cluster names
mapped_clusternames <- names(samples_representative)[match(rownames(distance_matrix_representativesamples), samples_representative)]
distance_matrix_representativesamples_renamed <- distance_matrix_representativesamples
rownames(distance_matrix_representativesamples_renamed) <- mapped_clusternames
colnames(distance_matrix_representativesamples_renamed) <- mapped_clusternames


clust <- distance_matrix_representativesamples_renamed %>% as.dist %>% hclust(., method = clustering_method) 
dendro <- clust %>% as.dendrogram

#dendro <- distance_matrix_representativesamples %>% as.dist %>% hclust(., method = clustering_method) %>% as.dendrogram
phylo <- clust %>% as.phylo


```

### Distance matrix between clusters

```{r plot distance_matrix_representativesamples}

#p1b <- plot_distance_matrix(distance_matrix_representativesamples_renamed, label_color = "black", param_color_thr = param_color_thr)

#print(p1b)

# TODO seperate per serovar

```


### Distance table between clusters

```{r distancetable_representativesamples}


distance_matrix_representativesamples_renamed.m <- reshape2::melt(distance_matrix_representativesamples_renamed)
colnames(distance_matrix_representativesamples_renamed.m) <- c("Cluster1","Cluster2","Distance")

# remove self hits
distance_matrix_representativesamples_renamed.m <- distance_matrix_representativesamples_renamed.m[distance_matrix_representativesamples_renamed.m$Cluster1 != distance_matrix_representativesamples_renamed.m$Cluster2 ,]



DT::datatable(distance_matrix_representativesamples_renamed.m, filter = 'top',rownames= FALSE, escape = FALSE,
          extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
    options = list(
                dom = 'BRrltpi',
                autoWidth=FALSE,
                scrollX = TRUE,
                order = list(2, "asc"),
                fixedColumns = FALSE,
                lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                ColReorder = TRUE,
                buttons =
                  list(
                    'copy',
                    'print',
                    list(
                      extend = 'collection',
                      buttons = c('csv', 'excel', 'pdf'),
                      text = 'Download'
                    ),
                    I('colvis')
                  )
              ))


```

### Inter-cluster relation as a `r paste0(clustering_method,"-linkage tree")`

The representative samples of each clusters were clustered using `r paste0(clustering_method,"-linkage")` hierarchical clustering. The coloring follows from a distance threshold of `r distance_threshold`.

```{r cluster_viz_details}

#color_value <- subcluster_counts[as.character(distance_threshold)]
color_value <- 3

if (length(phylo$tip.label) > 500) {
    my_cex_tiplabel <- 0.1
    my_cex_edgelabel <- 0.1
  } else if (length(phylo$tip.label) > 150) {
    my_cex_tiplabel <- 0.3
    my_cex_edgelabel <- 0.3
      } else if (length(phylo$tip.label) > 50) {
    my_cex_tiplabel <- 0.5
    my_cex_edgelabel <- 0.5
    } else{
    my_cex_tiplabel <- 0.8
    my_cex_edgelabel <- 0.8
  }


dendro %>% set("labels_cex", my_cex_tiplabel) %>% 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 seperate per serovar, 990er cluster

```


### Distance from samples to clusters

Shown here is a distance table which contains distances between all samples in column _Sample_ and selected representative samples of each cluster in column _Cluster\_representative_.

```{r Distance from samples to clusters}
# include orphans

# select query samples

distance_samplestoclusterreps <- distance_matrix[rownames(distance_matrix) %in% samples,colnames(distance_matrix) %in% samples_representative]

# select target samples

# melt matrix
distance_samplestoclusterreps.m <- reshape2::melt(distance_samplestoclusterreps)
colnames(distance_samplestoclusterreps.m) <- c("Sample","Cluster_representative","Distance")

cluster_summary_df2 <- cluster_summary_df[,c("representative sample","cluster name","external cluster name")]

# add metadata
distance_samplestoclusterreps.m <- merge(x=distance_samplestoclusterreps.m, y = cluster_summary_df2, by.x = "Cluster_representative", by.y = "representative sample", all.x = T, all.y = T)

distance_samplestoclusterreps.m <- distance_samplestoclusterreps.m[,c(which(colnames(distance_samplestoclusterreps.m) == "Sample"),which(colnames(distance_samplestoclusterreps.m) != "Sample"))]

distance_limit2 <- 50

distance_samplestoclusterreps.m <- distance_samplestoclusterreps.m[distance_samplestoclusterreps.m$Distance < distance_limit2,]


# print table
#head(distance_samplestoclusterreps.m)

DT::datatable(distance_samplestoclusterreps.m, filter = 'top',rownames= FALSE, escape = FALSE,
          extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
    options = list(
                dom = 'BRrltpi',
                autoWidth=FALSE,
                scrollX = TRUE,
                fixedColumns = FALSE,
                lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                ColReorder = TRUE,
                buttons =
                  list(
                    'copy',
                    'print',
                    list(
                      extend = 'collection',
                      buttons = c('csv', 'excel', 'pdf'),
                      text = 'Download'
                    ),
                    I('colvis')
                  )
              ))


```

Note that distances larger than `r distance_limit2` were omitted for performance reasons.




## Allele QC

The allele quality of each sample can be assessed from the fraction of missing loci. More details are available in the subsequent columns.

* Samples with _fraction of missing loci_ < `r bad_allele_threshold` are marked green.
* Samples with _fraction of missing loci_ < `r bad_allele_threshold2` are marked yellow.
* Samples with _fraction of missing loci_ > `r bad_allele_threshold2` are marked red.



```{r allele_stats, echo=FALSE}

# allele stats

if(nrow(allele_stats)>0){

  DT::datatable(allele_stats, filter = 'top',rownames= FALSE, escape = FALSE, 
            extensions = list("ColReorder" = NULL, "Buttons" = NULL, "FixedColumns" = list(leftColumns=1)),
      options = list(
                  dom = 'BRrltpi',
                  autoWidth=FALSE,
                  scrollX = TRUE,
                  order = list(list(1, 'asc'),list(5, 'desc')),
                  fixedColumns = TRUE,
                  lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                  ColReorder = TRUE,
                  buttons =
                    list(
                      'copy',
                      'print',
                      list(
                        extend = 'collection',
                        buttons = c('csv', 'excel', 'pdf'),
                        text = 'Download'
                      ),
                      I('colvis')
                    )
                )) %>%
    formatStyle(
        'Fraction of\nmissing loci',
        color = styleInterval(c(bad_allele_threshold, bad_allele_threshold2), c('white', 'black', 'white')),
        backgroundColor = styleInterval(c(bad_allele_threshold,bad_allele_threshold2), c('yellowgreen','yellow', 'darkred'))
      )

} else {
  print("No allele stats provided")
}
# more stats, viz
```


### 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.

```{r allele_stats_plots, echo=FALSE}

if(nrow(allele_stats)>0){

  ggplot(allele_stats, aes(x=EXC)) + geom_histogram(binwidth = 10) + xlab("Number of exact 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")

}

```



## Links to files

```{r export to file}
# export cluster_summary

if(export){

write.table(cluster_summary_df, file = cluster_summary_file, sep="\t", quote = F, row.names = T, col.names = NA)

# export clustering
ape::write.tree(phylo, file = clustering_intercluster.file)

# export inter-cluster distances
#write.table(distance_matrix_representativesamples_renamed, file = distancematrix_intercluster.file, sep = "\t", col.names = sub("Sample","ID",colnames(cluster_address_matrix_augmented)), row.names = F, quote = F)

}


```



All data is available at `r workdir`.



```{r file_info}
# The exported clustering files are in `r exportpath`


file_timestamps <- data.frame(
  name=c(
"distance matrix (as provided by grapetree)",
"distance matrix (with header and tab separated)",
"Minimum spanning tree",
"cluster summary file",
"samples in clusters",
"orphan samples",
"clustering_intercluster.file"
  ),
  file=c(
"distance_matrix.tsv",
"allele_distance_matrix.tsv",
"grapetree_mstree.tre",
"cluster_summary.tsv",
"sample_cluster_information.tsv",
"sample_orphan_information.tsv",
"clustering_intercluster.tre"
)
)

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")
  


```


## Config and parameters
All  parameters are defined in the file config.yaml:


```{r }

print(parameters)


```

The individual tools and their versions are listed in the .yaml files in the directory `env`

## Help


### Grapetree instructions
* Download / copy minimum spanning tree
* Open grapetree
* Load tree file
* Load one or more metadata tsv files with the sample name in the first column (e.g. bakcharak summary data, geospatial/temporal metadata)
* E.g. subset data to particular clade and export data as json for sharing

### Other tools
* iTOL
* phandango
* ...

