---
title: "AQUAMIS Assembly report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: html_document
theme: default
---

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

```{r setup, include = FALSE}

knitr::opts_chunk$set(out.width = '80%',
                      fig.asp = 0.5,
                      fig.align = 'center',
                      echo = FALSE,
                      warning = FALSE,
                      message = TRUE)

options(markdown.HTML.header = system.file("misc", "datatables.html", package = "knitr"))

library(tidyverse, quietly = T)
library(rrapply, quietly = T)
library(urltools, quietly = T)
library(DT, quietly = T)
# library(openxlsx, quietly = T)  # TODO: only necessary if thresholds are imported via excel file

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

```

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

```{r helper_functions, echo = FALSE}

currentScript <- function() {
  .getSourcedScriptName <- function() {
    for (i in sys.nframe():1) {
      x <- sys.frame(i)$ofile
      if (!is.null(x)) {return(normalizePath(x))}
    }
  }
  if (is.null(.getSourcedScriptName())) {
    return(normalizePath(rstudioapi::getActiveDocumentContext()$path))
  } else {
    .getSourcedScriptName()
  }
}

read_annotatedJSON <- function(file = "AQUAMIS_thresholds.json", .removeMetadata = TRUE){
  jsonlite::fromJSON(
    txt = file,
    simplifyVector = TRUE,
    simplifyDataFrame = TRUE,
    simplifyMatrix = TRUE,
    flatten = FALSE) %>%
    {if (.removeMetadata) {pluck(., "thresholds")}} %>% 
    rrapply::rrapply(object = .,
                     classes = c("list", "data.frame"),
                     f = function(.x){
                       if (!is_null(names(.x))) {names(.x) <- urltools::url_decode(names(.x))}
                       return(.x)},
                     how = "recurse") %>%
    rrapply::rrapply(object = .,
                     classes = c("data.frame"),
                     f = function(.x)as_tibble(.x),
                     how = "recurse") %>%
    rrapply::rrapply(object = .,  # this eliminates NULL fields and mitigates conversion errors into data.frames, this error only happens in R v3.5.1
                     classes = "NULL",
                     f = function(.x)if (is_null(.x)) {.x <- NA},
                     how = "recurse")
}

checkSpecies <- function(species_col, parameter_name, thresholds_table){
  map_chr(.x = species_col, .f = function(.species){
    .genus <- strsplit(.species, " ")[[1]][[1]]
    if (!is.null(thresholds_table[[.species]][[parameter_name]])) {
      return(.species)  # species variable is a valid species or genus and parameter is present
    } else if (!is.null(thresholds_table[[.genus]][[parameter_name]])) {  ## Check if Parameter is present in species or species-agnostic
      return(.genus)  # species variable is a valid species or genus and parameter is present
    } else if (!is.null(thresholds_table[["all Species"]][[parameter_name]])) {  ## Check if Parameter is present in species or species-agnostic
      return("all Species") # parameter is species-agnostic
    } else {
      return("speciesFail") # parameter is not present
    }
  })
}  ## Check if check if Reference Name has a Threshold on Species or Genus Level

assessThresholds <- function(species_col, parameter_col, parameter_name, thresholds_table){
  thresholds_table[["speciesFail"]][[parameter_name]] <- tibble(
    "interval" = list(c(NULL)),
    "binscore" = list(c(NULL)))
  
  score_col <- suppressWarnings(
    map2(.x = checkSpecies(species_col, parameter_name, thresholds_table),
         .y = parameter_col,
         .f = function(.species, .parameter_col){
           .interval <- thresholds_table[[.species]][[parameter_name]][["interval"]][[1]]
           .min <- min(c(as.numeric(parameter_col), as.numeric(.interval)), na.rm = TRUE) - (pi / round(pi, 2) - 1)  # min has to be lower than lowest interval AND lowest value
           .max <- max(c(as.numeric(parameter_col), as.numeric(.interval)), na.rm = TRUE) + (pi / round(pi, 2) - 1)  # breaks have to be unique, irrationality should do the trick
           if (all(sapply(.interval, is.numeric))) {
             .binscore <- thresholds_table[[.species]][[parameter_name]][["binscore"]][[1]]
           } else {
             .binscore <- NULL
           }
           .score_col <- cut(x = as.numeric(.parameter_col),
                             breaks = c(.min, .interval, .max),
                             labels = .binscore, include.lowest = TRUE)
           return(.score_col)
         }) %>% 
      unlist() %>% 
      as.character() %>% 
      as.integer()
  )
  
  return(score_col)
}

colorThresholds <- function(species_col, parameter_col, parameter_name, thresholds_table){
  color_col <- map2_chr(
    .x = checkSpecies(species_col, parameter_name, thresholds_table),
    .y = parameter_col,
    .f = function(.species, .parameter_col){
      if (.species %in% names(thresholds_table) & parameter_name %in% names(thresholds_table[[.species]])){
        binDict <- tibble(binscore=thresholds_table[[.species]][[parameter_name]][["binscore"]][[1]],
                          bincolor=thresholds_table[[.species]][[parameter_name]][["bincolor"]][[1]]) %>%
          distinct() %>%
          deframe
        stopifnot(all(!duplicated(names(binDict))))
        .binColor <- recode(.x = .parameter_col,
                            !!!binDict,
                            .default = "pink",
                            .missing = "lightgrey")
      } else {
        .binColor <- "lightgrey"
      }
      return(.binColor)
    })
  return(color_col)
}

```

```{r DEBUG_override_snakemake, echo = FALSE}

if (!exists("snakemake")) {
  source(file = file.path(dirname(currentScript()), gsub("\\.Rmd", "_debug.R", basename(currentScript()))))
} else {
  # Activate Logging
  logfile <- file(snakemake@log[["log"]], open = "wt")
  sink(file = logfile, type = c("output", "message"))
  # message(str(snakemake))
}

setwd(dir = snakemake@config$workdir)

```

```{r import_thresholds, echo = FALSE}

thresholds <- read_annotatedJSON(file = snakemake@config$params$qc$thresholds)

thresholds_available <- unique(unlist(map(thresholds, names)))

```

```{r import_sample_JSONs_post_assembly, echo = FALSE}

samples_post_assembly <- gsub(pattern = "\\.json$", replacement = "", basename(snakemake@input$json_in))

json_sample_str_post <- purrr::set_names(
  x = purrr::map(snakemake@input$json_in,
                 function(.x)readr::read_file(file = .x)),
  nm = samples_post_assembly)

json_sample_obj_post <- purrr::set_names(
  x = purrr::map(json_sample_str_post,
                 function(.x)jsonlite::fromJSON(
                   txt = .x,
                   simplifyVector = TRUE,
                   simplifyDataFrame = TRUE,
                   simplifyMatrix = TRUE,
                   flatten = FALSE)) %>% 
    rrapply::rrapply(object = .,
                     classes = c("list", "data.frame"),
                     f = function(.x) {
                       if (!is_null(names(.x))) {names(.x) <- urltools::url_decode(names(.x))}
                       return(.x)
                     },
                     how = "recurse") %>%
    rrapply::rrapply(object = .,  # this eliminates NULL fields and mitigates conversion errors into data.frames, this error only happens in R v3.5.1
                     classes = "NULL",
                     f = function(.x) if (is_null(.x)) {.x <- NA},
                     how = "recurse"),
  nm = names(json_sample_str_post))

```

```{r import_sample_JSONs_pre_assembly, echo = FALSE}

samples_pre_assembly_path <- list.files(path = gsub(pattern = "post_assembly", replacement = "pre_assembly", x = dirname(snakemake@input$json_in[[1]])),
                                        pattern = "\\.json$",
                                        full.names = TRUE)

if (length(samples_pre_assembly_path) < 1) {
  message("The pre-assembly result directory contains no JSON files.")
  stopifnot(length(samples_pre_assembly_path) < 1)
}

samples_pre_assembly <- gsub(pattern = "\\.json", replacement = "", x = basename(samples_pre_assembly_path))

if (length(setdiff(samples_post_assembly, samples_pre_assembly)) > 0) {
  message("The post-assembly result directory contains samples that do not have corresponding pre-assembly results.")
  stopifnot(length(setdiff(samples_post_assembly, samples_pre_assembly)) > 0)
}

if (length(intersect(samples_pre_assembly, samples_post_assembly)) < 1) {
  message("The pre- and post-assembly result directories do not share JSON files for the same samples.")
  stopifnot(length(intersect(samples_pre_assembly, samples_post_assembly)) < 1)
}

json_sample_str_pre <- purrr::set_names(
  x = purrr::map(samples_pre_assembly_path,
                 function(.x)readr::read_file(file = .x)),
  nm = samples_pre_assembly)

json_sample_obj_pre <- purrr::set_names(
  x = purrr::map(json_sample_str_pre,
                 function(.x)jsonlite::fromJSON(
                   txt = .x,
                   simplifyVector = TRUE,
                   simplifyDataFrame = TRUE,
                   simplifyMatrix = TRUE,
                   flatten = FALSE)) %>% 
    rrapply::rrapply(object = .,
                     classes = c("list", "data.frame"),
                     f = function(.x) {
                       if (!is_null(names(.x))) {names(.x) <- urltools::url_decode(names(.x))}
                       return(.x)
                     },
                     how = "recurse") %>%
    rrapply::rrapply(object = .,  # this eliminates NULL fields and mitigates conversion errors into data.frames, this error only happens in R v3.5.1
                     classes = "NULL",
                     f = function(.x) if (is_null(.x)) {.x <- NA},
                     how = "recurse"),
  nm = names(json_sample_str_pre))

```

```{r read_data, echo = FALSE, warning = FALSE, message = TRUE, cache = FALSE}

# infer run name from snakemake@config$workdir
run <- ifelse(test = snakemake@config$params$run_name == "",
              yes = snakemake@config$workdir,
              no = snakemake@config$params$run_name)

runName <- ifelse(test = snakemake@config$params$run_name == "",
                  yes = "not specified",
                  no = snakemake@config$params$run_name)

#read fails data
fails <- scan(file.path(snakemake@config$workdir, snakemake@input[["fails"]]),
              what = character(),
              sep = "\n",
              quiet = T)

# read fastp data
fastp_data <- json_sample_obj_pre %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "fastp", "report"),
                 .id = "sample") %>% 
  mutate(link_to_report = purrr::map_chr(
    .x = sample,
    .f = function(.x)paste0("<a href=",
                            file.path("..", "trimmed", "reports", paste0(.x, ".html")),
                            "> fastp </a>")))

# read confindr data
confindr <- json_sample_obj_pre %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "confindr"),
                 .id = NULL) %>% 
  select(-version, -timestamp) %>% 
  mutate_at(.vars = vars(any_of("ContamStatus")),
            .funs = ~ factor(x = ., levels = c("False", "Intra", "Inter"), ordered = TRUE)) %>% 
  rename(sample = Sample)

# read kraken2 data - parsing either on species or genus level depends on user choice in config.yaml, default is genus
kraken_taxon_ranks = c(
  "K" = "kingdom",  # NOTE: Currently, only genus and species are supported
  "P" = "phylum",
  "C" = "class",
  "O" = "order",
  "F" = "family",
  "G" = "genus",
  "S" = "species")

taxon_qc_level <- as.character(kraken_taxon_ranks[snakemake@config$params$kraken2$taxonomic_qc_level])

kraken2_reads_species <- json_sample_obj_pre %>%
  purrr::map(.x = .,
             .f = function(.x)purrr::pluck(.x = .x, "pipelines", "kraken2", "read_based", "bracken_summary_species") %>%
               as_tibble() %>%
               {if (names(.)[[1]] == .[1, 1, drop = TRUE]) slice(.data = ., -1) else .} %>% # failsafe if first row is not a duplicate of column names
               arrange(desc(fraction_total_reads)) %>% 
               slice_head(n = 3)) %>%
  bind_rows(., .id = "sample") %>% 
  select(sample, name, fraction_total_reads) %>% 
  group_by(sample) %>% 
  mutate(rank_name = paste0("read_hit", row_number(), "_species"),
         rank_fraction = paste0("read_hit", row_number(), "_species_fraction")) %>% 
  pivot_longer(cols = c(name, fraction_total_reads), names_to = "key", values_to = "value") %>% 
  mutate(key = ifelse(test = key == "name", yes = rank_name, no = rank_fraction)) %>% 
  pivot_wider(id_cols = sample, names_from = key, values_from = value) %>% 
  mutate_at(.vars = vars(ends_with("_fraction")), .funs = ~ as.double(.))

kraken2_reads_genus <- json_sample_obj_pre %>%
  purrr::map(.x = .,
             .f = function(.x)purrr::pluck(.x = .x, "pipelines", "kraken2", "read_based", "bracken_summary_genus") %>%
               as_tibble() %>%
               {if (names(.)[[1]] == .[1, 1, drop = TRUE]) slice(.data = ., -1) else .} %>% # failsafe if first row is not a duplicate of column names
               arrange(desc(fraction_total_reads)) %>% 
               slice_head(n = 3)) %>%
  bind_rows(., .id = "sample") %>% 
  select(sample, name, fraction_total_reads) %>% 
  group_by(sample) %>% 
  mutate(rank_name = paste0("read_hit", row_number(), "_genus"),
         rank_fraction = paste0("read_hit", row_number(), "_genus_fraction")) %>% 
  pivot_longer(cols = c(name, fraction_total_reads), names_to = "key", values_to = "value") %>% 
  mutate(key = ifelse(test = key == "name", yes = rank_name, no = rank_fraction)) %>% 
  pivot_wider(id_cols = sample, names_from = key, values_from = value) %>% 
  mutate_at(.vars = vars(ends_with("_fraction")), .funs = ~ as.double(.))

kraken2_contigs_species <- json_sample_obj_post %>%
  purrr::map(.x = .,
             .f = function(.x)purrr::pluck(.x = .x, "pipelines", "kraken2", "contig_based", "kraken_summary_species") %>%
               as_tibble() %>%
               {if (names(.)[[1]] == .[1, 1, drop = TRUE]) slice(.data = ., -1) else .} %>% # failsafe if first row is not a duplicate of column names
               arrange(desc("species_cumlength")) %>%
               slice_head(n = 3)) %>%
  bind_rows(., .id = "sample") %>%
  select(sample, starts_with("species")) %>%
  mutate_all(.tbl = ., .funs = ~ as.character(.)) %>% 
  group_by(sample) %>%
  mutate(rank_taxon = paste0("contig_hit", row_number(), "_species"),
         rank_cumlength = paste0("contig_hit", row_number(), "_cumlength"),
         rank_fraction = paste0("contig_hit", row_number(), "_species_fraction")) %>%
  pivot_longer(cols = starts_with("species"), names_to = "key", values_to = "value") %>%
  mutate(key = ifelse(test = key == "species",
                      yes = rank_taxon,
                      no = ifelse(test = key == "species_cumlength",
                                  yes = rank_cumlength,
                                  no = rank_fraction))) %>%
  pivot_wider(id_cols = sample, names_from = key, values_from = value) %>% 
  mutate_at(.vars = vars(ends_with("_cumlength")), .funs = ~ as.integer(.)) %>% 
  mutate_at(.vars = vars(ends_with("_fraction")), .funs = ~ as.double(.))

kraken2_contigs_genus <- json_sample_obj_post %>%
  purrr::map(.x = .,
             .f = function(.x)purrr::pluck(.x = .x, "pipelines", "kraken2", "contig_based", "kraken_summary_genus") %>%
               as_tibble() %>%
               {if (names(.)[[1]] == .[1, 1, drop = TRUE]) slice(.data = ., -1) else .} %>% # failsafe if first row is not a duplicate of column names
               arrange(desc("genus_cumlength")) %>%
               slice_head(n = 3)) %>%
  bind_rows(., .id = "sample") %>%
  select(sample, starts_with("genus")) %>%
  mutate_all(.tbl = ., .funs = ~ as.character(.)) %>% 
  group_by(sample) %>%
  mutate(rank_taxon = paste0("contig_hit", row_number(), "_genus"),
         rank_cumlength = paste0("contig_hit", row_number(), "_cumlength"),
         rank_fraction = paste0("contig_hit", row_number(), "_genus_fraction")) %>%
  pivot_longer(cols = starts_with("genus"), names_to = "key", values_to = "value") %>%
  mutate(key = ifelse(test = key == "genus",
                      yes = rank_taxon,
                      no = ifelse(test = key == "genus_cumlength",
                                  yes = rank_cumlength,
                                  no = rank_fraction))) %>%
  pivot_wider(id_cols = sample, names_from = key, values_from = value) %>% 
  mutate_at(.vars = vars(ends_with("_cumlength")), .funs = ~ as.integer(.)) %>% 
  mutate_at(.vars = vars(ends_with("_fraction")), .funs = ~ as.double(.))

# read mash data
mash_data <- json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "mash"),
                 .id = "sample") %>% 
  mutate(fraction = shared_hashes / total_hashes) %>% 
  select(sample, reference, distance, pvalue, shared_hashes, total_hashes, fraction)

# read mlst data
mlst <- json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "mlst") %>%
                   purrr::list_modify("alleles" = NULL),
                 .id = NULL) %>%
  select(-version, -timestamp) %>%
  rename(sample = id) %>%
  rename_at(.tbl = ., .vars = vars(-sample), .funs = ~ paste0("mlst_", .)) %>% 
  mutate_at(.vars = vars(any_of("mlst_sequence_type")), .funs = ~ as.integer(.))

# read aquamis summary incl. quast data
stats <- json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "sample", "summary"),
                 .id = "sample")


```

```{r links, echo = FALSE}

links_df <- stats %>% 
  select(sample, reference) %>% 
  mutate(ncbi_accession = str_split(string = reference, pattern = " ", simplify = TRUE)[, 1],
         fasta  = paste0("<a href = ", file.path("..", "Assembly", "assembly", paste(samples_post_assembly, "fasta", sep = ".")), "> file </a>"),
         ncbi   = paste0("<a href = ", "https://www.ncbi.nlm.nih.gov/nuccore/", ncbi_accession, "?report = docsum>", ncbi_accession,     "</a>"),
         icarus = paste0("<a href = ", file.path("..", "Assembly", sample, "quast", "icarus_viewers", "alignment_viewer.html"), "> ikarus </a>"),
         quast  = paste0("<a href = ", file.path("..", "Assembly", sample, "quast", "report.html"),                              "> quast </a>")) %>% 
  select(-reference, -ncbi_accession)

```

```{r compute_morestats, echo = FALSE}

# compute average insert size
insert_sizes_mean <- json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "samstats", "insert_size"),
                 .id = "sample") %>% 
  group_by(sample) %>% 
  summarise(insert_mean = sum(insert_size * count) / sum(count), .groups = "drop_last")

```

```{r column_definitions, echo = FALSE}

## Column Selection for Summary (selectedColumns_short) and Details (selectedColumns) Tables ####
linkColumns <- c(
  "link_to_report",
  "fasta",
  "ncbi",
  "ikarus",
  "quast")

selectedColumns <- c(
  "sample",
  "qc_VOTE",
  "qc_FAIL",
  "qc_WARNING",
  "qc_NA",
  "species",
  "reference",
  "ref_acc",
  "reads_total",
  "base_count",
  "q30_rate_after",
  "assembly_coverageDepth",
  "# contigs (>= 0 bp)",
  "# contigs (>= 1000 bp)",
  "N50",
  "read_hit1_species_fraction",
  "read_hit1_genus_fraction",
  "contig_hit1_species_fraction",
  "contig_hit1_genus_fraction",
  "ContamStatus",
  "NumContamSNVs",
  "busco_single",  # BUSCO
  "busco_duplicates",  # BUSCO
  "mlst_multi_allele_loci",
  "mlst_loci_missing",
  "mlst_scheme",
  "mlst_sequence_type",
  "genes_full",
  "genes_partial",
  "fraction_genes_recovered",
  "Genome fraction (%)",
  "Duplication ratio",
  "GC (%)",
  "Total length",
  "Reference length",
  "fraction",
  "fraction_reads_mapped",
  "insert_mean",
  "link_to_report",
  linkColumns)

selectedColumns_short <- c(
  "sample",
  "qc_VOTE",
  "species",
  "Total length",
  "# contigs (>= 0 bp)",
  "q30_rate_after",
  "assembly_coverageDepth",
  paste0("read_hit1_", taxon_qc_level, "_fraction"),
  paste0("contig_hit1_", taxon_qc_level, "_fraction"),
  "ContamStatus",
  "NumContamSNVs",
  "mlst_multi_allele_loci")

## Renaming Dictionaries - table "stats_selected" to DT column names ####
jsonNames_to_tableNames <- c(
  "sample"                       = "Sample\nName",
  "qc_VOTE"                      = "QC\nVote",
  "qc_FAIL"                      = "QC\nFail",
  "qc_WARNING"                   = "QC\nWarn",
  "qc_NA"                        = "QC\nN.D.",
  "reference"                    = "Reference",
  "ref_acc"                      = "Reference\nAccession",
  "species"                      = "Species",
  "reads_total"                  = "# Reads",
  "base_count"                   = "Megabases",
  "q30_rate_after"               = "Q30\nBase\nFraction",
  "assembly_coverageDepth"       = "Coverage\nDepth",
  "# contigs (>= 0 bp)"          = "# Contigs",
  "# contigs (>= 1000 bp)"       = "# Contigs\n>1000 bp",
  "N50"                          = "N50",
  "read_hit1_species_fraction"   = "Read\nFraction\nMajority\nSpecies",
  "read_hit1_genus_fraction"     = "Read\nFraction\nMajority\nGenus",
  "contig_hit1_species_fraction" = "Contig\nFraction\nMajority\nSpecies",
  "contig_hit1_genus_fraction"   = "Contig\n Fraction\nMajority\nGenus",
  "ContamStatus"                 = "Contam.\nStatus",
  "NumContamSNVs"                = "Contam.\n# SNVs",
  "busco_single"                 = "Single-Copy\nOrthologs",  # BUSCO
  "busco_duplicates"             = "Duplicated\nOrthologs",  # BUSCO
  "mlst_multi_allele_loci"       = "MLST\nLoci w/\nMultiple\nAlleles",
  "mlst_loci_missing"            = "MLST\nLoci\nMissing",
  "mlst_scheme"                  = "MLST\nSchema",
  "mlst_sequence_type"           = "MLST\nST",
  "genes_full"                   = "# Full\nGenes",
  "genes_partial"                = "# Partial\nGenes",
  "fraction_genes_recovered"     = "Fraction\nGenes\nRecovered",
  "Genome fraction (%)"          = "Reference\nCoverage",
  "Duplication ratio"            = "Duplication\nRatio",
  "GC (%)"                       = "GC",
  "Total length"                 = "Total\nLength",
  "Reference length"             = "Reference\nLength",
  "fraction"                     = "Reference\nSimilarity",
  "fraction_reads_mapped"        = "Fraction\nMapped\nReads",
  "insert_mean"                  = "Insert\nSize",
  "link_to_report"               = "Trimming\nDetails",
  "fasta"                        = "FASTA",
  "ncbi"                         = "NCBI",
  "ikarus"                       = "Ikarus",
  "quast"                        = "QUAST")

tableNames_to_jsonNames <- set_names(x = names(jsonNames_to_tableNames), nm = jsonNames_to_tableNames)

## Renaming Dictionaries - table "stats_selected" to LIMS-compatible names for tsv export ####
jsonNames_to_exportNames <- c(
  "sample"                       = "Sample_Name",
  "qc_VOTE"                      = "QC_Vote",
  "qc_FAIL"                      = "QC_Fail",
  "qc_WARNING"                   = "QC_Warning",
  "qc_NA"                        = "QC_NotDetermined",
  "reference"                    = "Reference",
  "ref_acc"                      = "Reference_Accession",
  "species"                      = "Species",
  "reads_total"                  = "n_Reads",
  "base_count"                   = "Megabases",
  "q30_rate_after"               = "Q30_Base_Fraction",
  "assembly_coverageDepth"       = "Coverage_Depth",
  "# contigs (>= 0 bp)"          = "n_Contigs_Length_0",
  "# contigs (>= 1000 bp)"       = "n_Contigs_Length_1000",
  "N50"                          = "N50",
  "read_hit1_species_fraction"   = "Read_Fraction_Majority_Species",
  "read_hit1_genus_fraction"     = "Read_Fraction_Majority_Genus",
  "contig_hit1_species_fraction" = "Contig_Fraction_majority_species",
  "contig_hit1_genus_fraction"   = "Contig_fraction_majority_genus",
  "ContamStatus"                 = "Contamination_Status",
  "NumContamSNVs"                = "Contaminating_SNVs",
  "busco_single"                 = "Single_Copy_Orthologs",
  "busco_duplicates"             = "Duplicated_Orthologs",
  "mlst_multi_allele_loci"       = "MLST_Loci_Multiple_Alleles",
  "mlst_loci_missing"            = "MLST_Loci_Missing",
  "mlst_scheme"                  = "MLST_Schema",
  "mlst_sequence_type"           = "MLST_ST",
  "genes_full"                   = "n_Full_Genes",
  "genes_partial"                = "n_Partial_genes",
  "fraction_genes_recovered"     = "Fraction_Genes_Recovered",
  "Genome fraction (%)"          = "Reference_Coverage",
  "Duplication ratio"            = "Duplication_Ratio",
  "GC (%)"                       = "GC",
  "Total length"                 = "Total_Length",
  "Reference length"             = "Reference_Length",
  "fraction"                     = "Reference_Similarity",
  "fraction_reads_mapped"        = "Fraction_Mapped_Reads",
  "insert_mean"                  = "Insert_Size",
  "fasta"                        = "Fasta_File")

exportNames_to_jsonNames <- set_names(x = names(jsonNames_to_exportNames), nm = jsonNames_to_exportNames)

## Column Names Description for Help Tab of Details Tables ####
help <- c(
  "Sample Name"                    = "Name of sample",
  "QC Vote"                        = "Recommended quality assessment based all criteria (PASS or FAIL)",
  "QC Fail"                        = "Number of fields falling below the fail threshold",
  "QC Warn"                        = "Number of fields falling below the warning threshold",
  "QC N.D."                        = "Number of fields where no threshold could be applied, either by missing value or missing genus/species-specific threshold",
  "Reference"                      = "Best NCBI complete genome according to mash",
  "Reference Accession"            = "Accession number of best NCBI complete genome according to mash",
  "Species"                        = "Species of best NCBI complete genome according to mash",
  "# Reads"                        = "Number of reads after trimming",
  "Megabases"                      = "Number of bases from all trimmed reads",
  "Q30 Base Fraction"              = "Fraction of bases that have Q30 or higher",
  "Coverage Depth"                 = "Average depth over all positions and contigs",
  "# Contigs"                      = "Number of contigs larger 0 base pairs",
  "# Contigs >1000 bp"             = "Number of contigs larger 1000 base pairs",
  "N50"                            = "N50 value in basepairs (indicator of average contig size and assembly quality)",
  "Read Fraction Majority Taxon"   = "Fraction of reads assigned to the most abundant taxonomic rank, e.g. species or genus",
  "Contig Fraction Majority Taxon" = "Fraction of contigs assigned to the most abundant taxonomic rank, e.g. species or genus",
  "Contam. Status"                 = "Contamination Status",
  "Contam. # SNVs"                 = "Number of contaminating Single Nucleotide Variations",
  "Single-Copy Orthologs"          = "Fraction of universal single-copy orthologs that were found. Values below 1 indicate incompleteness",  # BUSCO
  "Duplicated Orthologs"           = "Fraction of universal single-copy orthologs that were found in duplicate. Non-zero indicate contamination",  # BUSCO
  "MLST Loci w/ Multiple Alleles"  = "MLST loci with multiple alleles, an indicator of intra-species contamination",
  "MLST Loci Missing"              = "missing MLST loci, compare to ST in scheme to confirm a true miss",
  "MLST Schema"                    = "MLST schema - determined automatically (default) or chosen by user",
  "MLST ST"                        = "MLST sequence type of associated MLST schema",
  "# Full Genes"                   = "Number of reference genes found",
  "# Partial Genes"                = "Number of reference genes partially found",
  "Fraction Genes Recovered"       = "Fraction of genes found compared to all reference genes, includes partial matches",
  "Reference Coverage"             = "Genome coverage compared to reference",
  "Duplication Ratio"              = "Total number of aligned bases in the assembly divided by the total number of aligned bases in the reference genome",
  "GC"                             = "Total number of G and C nucleotides in the assembly, divided by the total length of the assembly",
  "Total Length"                   = "Sum of all contigs",
  "Reference Length"               = "Length of reference genomes",
  "Reference Similarity"           = "Similarity to reference according to mash. The value describes the fraction of shared kmers",
  # "xxx"                            = "Number of contigs that could be circularized (flagged  with 'circular = true' in fasta header)",
  "Fraction Mapped Reads"          = "Fraction of reads that map to contigs. Values below 1 indicate assembly issues",
  "Insert Size"                    = "Calculated fragment length, i.e. read length plus insert size",
  "Trimming Details"               = "fastp report with details related to read trimming and read QC",
  "FASTA"                          = "Link to assembly file",
  "NCBI"                           = "Link to reference NCBI entry",
  "Ikarus"                         = "Link to ikarus report on structural comparison to reference",
  "QUAST"                          = "Link to assembly quality report"
)

## Integrity Test ####
topic <- gsub(pattern = "\n",
              replacement =  " ",
              x = map_chr(.x = selectedColumns,
                          .f = ~ ifelse(test = . %in% names(jsonNames_to_tableNames),
                                        yes = jsonNames_to_tableNames[.],
                                        no = .)))

stopifnot(length(setdiff(selectedColumns_short, selectedColumns)) == 0)
stopifnot(length(setdiff(selectedColumns, names(jsonNames_to_tableNames))) == 0)
# stopifnot(length(setdiff(names(help), topic)) == 0)  # kraken taxon rank variability omits test
# stopifnot(length(setdiff(topic, names(help))) == 0)  # kraken taxon rank variability omits test

```

```{r process_data, echo = FALSE}

# merge results
results <- left_join(x = fastp_data, y = stats,                by = "sample")
results <- left_join(x = results, y = mash_data,               by = "sample")
results <- left_join(x = results, y = insert_sizes_mean,       by = "sample")
results <- left_join(x = results, y = kraken2_reads_species,   by = "sample")
results <- left_join(x = results, y = kraken2_reads_genus,     by = "sample")
results <- left_join(x = results, y = kraken2_contigs_species, by = "sample")
results <- left_join(x = results, y = kraken2_contigs_genus,   by = "sample")
results <- left_join(x = results, y = confindr,                by = "sample")
results <- left_join(x = results, y = mlst,                    by = "sample")
results <- left_join(x = results, y = links_df,                by = "sample")

# select columns and add species column
stats_selected <- results %>%
  filter(sample %in% samples_post_assembly) %>% 
  separate(col = reference.x, into = c("ref_acc", "reference"), sep = "\\s", extra = "merge") %>% 
  mutate(reference = gsub("chromosome|,|complete genome|", "", reference),  # clean name
         reference = gsub("\\s+", " ", str_trim(reference)),  # trim whitespaces
         species = map_chr(
           .x = reference,
           .f = ~ paste(str_extract_all(string = .,
                                        pattern = "\\b\\w+\\b",
                                        simplify = TRUE)[, c(1, 2)],
                        collapse = " "))) %>% # derive genus and species name
  select(intersect(selectedColumns, names(.)))


# Numeric Format Changes
stats_selected$base_count <- stats_selected$base_count/10^6
if (is.numeric(stats_selected$busco_single)) {stats_selected$busco_single <- stats_selected$busco_single/100}  # BUSCO
if (is.numeric(stats_selected$busco_duplicates)) {stats_selected$busco_duplicates <- stats_selected$busco_duplicates/100}  # BUSCO
stats_selected["Genome fraction (%)"] <- stats_selected["Genome fraction (%)"]/100

```

```{r generate_DataTables, echo = FALSE}

## (1) detailed_assembly_summary ----

## (1.1) Clone Result Table for Thresholds Assessment ----
thresholds_excluded <- do.call(paste0, expand.grid(
  c("read_hit1_", "contig_hit1_"), 
  kraken_taxon_ranks[setdiff(names(kraken_taxon_ranks), snakemake@config$params$kraken2$taxonomic_qc_level)],
  "_fraction"))

thresholds_intersect <- intersect(names(stats_selected), setdiff(thresholds_available, thresholds_excluded))

stats_selected_tripple <- stats_selected %>%
  left_join(x = .,
            y = stats_selected %>% 
              select("sample", any_of(thresholds_intersect)),
            by = c("sample" = "sample"),
            suffix = c("", ".score")) %>% 
  left_join(x = .,
            y = stats_selected %>% 
              select("sample", any_of(thresholds_intersect)),
            by = c("sample" = "sample"),
            suffix = c("", ".color"))

## (1.2) Thresholds Assessment ----
stats_selected_full <- stats_selected_tripple %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect, ".score"))),
            .funs = function(.x)assessThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.score", "", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.score", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds)) %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect, ".color"))),
            .funs = function(.x)colorThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.color", ".score", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.color", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds)) %>%
  select(-c(species, ref_acc))

## (1.3) Quality Control Vote ----
stats_selected_qc_parameter <- as_tibble(stats_selected_full) %>%
  select(any_of(c("sample", paste0(thresholds_intersect, ".score")))) %>%
  mutate_at(.vars = vars(ends_with(".score")),
            .funs = ~ if_else(. < 0, as.integer(0), .)) %>%  # ignore any positive threshold assessments, e.g. blue cells with a negative score
  mutate_at(.vars = vars(ends_with(".score")),
            .funs = ~ factor(x = .,
                             levels = c(0, 1, 2),
                             labels = c("PASS", "WARNING", "FAIL"))) %>% 
  mutate(!!paste0("kraken_hit1_", taxon_qc_level, "_fraction.score") := map2_chr(  # custom Kraken2 assessment
    .x = .[[paste0("read_hit1_", taxon_qc_level, "_fraction.score")]],
    .y = .[[paste0("contig_hit1_", taxon_qc_level, "_fraction.score")]],
    .f = function(.bracken, .taxonkit)ifelse(
      test = .bracken == "PASS" & .taxonkit == "PASS",
      yes = "PASS",
      no = ifelse(test = .bracken == "FAIL" & .taxonkit == "FAIL",
                  yes = "FAIL",
                  no = "WARNING"))))

stats_selected_qc_vote <- stats_selected_qc_parameter %>% 
  select(-matches(c("read_hit1_", "contig_hit1_"))) %>% 
  pivot_longer(-sample) %>% 
  # replace_na(list(value = "WARNING")) %>%  # TODO: Decision on how to treat missing variables, are those FAILS?
  count(sample, value) %>% 
  pivot_wider(id_cols = "sample",
              names_from = "value",
              names_prefix = "qc_",
              values_from = "n",
              values_fill = 0) %>% 
  {if (!"qc_FAIL"    %in% names(.)) {add_column(.data = ., "qc_FAIL"    = 0, .after = "sample"    )} else {.}} %>% 
  {if (!"qc_PASS"    %in% names(.)) {add_column(.data = ., "qc_PASS"    = 0, .after = "qc_FAIL"   )} else {.}} %>% 
  {if (!"qc_WARNING" %in% names(.)) {add_column(.data = ., "qc_WARNING" = 0, .after = "qc_PASS"   )} else {.}} %>% 
  {if (!"qc_NA"      %in% names(.)) {add_column(.data = ., "qc_NA"      = 0, .after = "qc_WARNING")} else {.}} %>%  # TODO: if missing variables are transformed to FAIL/WARNING (s.o. in this pipe), remove this line
  mutate(qc_VOTE = factor(x = ifelse(test = qc_FAIL > 0, yes = 2, no = 0),
                          levels = c(0, 1, 2),
                          labels = c("PASS", "WARNING", "FAIL")))

stats_selected_qc <- full_join(
  x = stats_selected_qc_parameter,
  y = stats_selected_qc_vote,
  by = "sample")

## (2) short_summary with QC Vote ----
stats_selected_short <- stats_selected %>% 
  left_join(x = ., y = stats_selected_qc %>% select(sample, qc_VOTE), by = "sample") %>% 
  select(intersect(selectedColumns_short, names(.)))

## (2.1) Clone Result Table for Thresholds Assessment ----
thresholds_intersect_short <- intersect(names(stats_selected_short), thresholds_available)

stats_selected_short_tripple <- stats_selected_short %>%
  left_join(x = .,
            y = stats_selected_short %>% 
              select("sample", any_of(thresholds_intersect_short)),
            by = c("sample" = "sample"),
            suffix = c("", ".score")) %>% 
  left_join(x = .,
            y = stats_selected_short %>% 
              select("sample", any_of(thresholds_intersect_short)),
            by = c("sample" = "sample"),
            suffix = c("", ".color"))

## (2.2) Thresholds Assessment ----
stats_selected_short_full <- stats_selected_short_tripple %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect_short, ".score"))),
            .funs = function(.x)assessThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.score", "", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.score", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds)) %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect_short, ".color"))),
            .funs = function(.x)colorThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.color", ".score", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.color", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds))

## (3) Append QC Vote to detailed_assembly_summary and Redo Thresholds Assessment ----

stats_selected <- stats_selected %>% 
  left_join(x = ., y = stats_selected_qc %>% select(sample, qc_VOTE, qc_FAIL, qc_WARNING, qc_NA), by = "sample") %>% 
  select(any_of(selectedColumns))

thresholds_intersect <- intersect(names(stats_selected), setdiff(thresholds_available, thresholds_excluded))

stats_selected_tripple <- stats_selected %>%
  left_join(x = .,
            y = stats_selected %>% 
              select("sample", any_of(thresholds_intersect)),
            by = c("sample" = "sample"),
            suffix = c("", ".score")) %>% 
  left_join(x = .,
            y = stats_selected %>% 
              select("sample", any_of(thresholds_intersect)),
            by = c("sample" = "sample"),
            suffix = c("", ".color"))

stats_selected_full <- stats_selected_tripple %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect, ".score"))),
            .funs = function(.x)assessThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.score", "", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.score", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds)) %>%
  mutate_at(.vars = vars(any_of(paste0(thresholds_intersect, ".color"))),
            .funs = function(.x)colorThresholds(
              species_col = .[["species"]],
              parameter_col = .[[gsub("\\.color", ".score", rlang::as_label(substitute(.x)))]],
              parameter_name = gsub("\\.color", "", rlang::as_label(substitute(.x))),
              thresholds_table = thresholds)) %>%
  select(-c(species, ref_acc))

# count qc fails
qc_fails <- sum(stats_selected$qc_VOTE == "FAIL", na.rm = T)

```

```{r export_tables, echo = FALSE}

get(x = paste0("kraken2_contigs_", taxon_qc_level)) %>%  # NOTE: this output depends on user choice for taxon_qc_level
  write_tsv(file = file.path(snakemake@config$workdir, snakemake@params[["tsv_kraken2_contigs"]]))

stats %>%
  add_column(.data = ., "run_name" = runName, .before = "version") %>%
  write_tsv(file = file.path(snakemake@config$workdir, snakemake@params[["tsv_assembly"]]))

stats_selected %>% 
  select(-any_of(linkColumns)) %>%
  add_column(.data = ., "run_name" = run) %>% 
  left_join(x = ., y = stats %>% select(sample, version, timestamp), by = "sample") %>% 
  mutate(fasta = map_chr(.x = sample,
                         .f = function(.sample)ifelse(
                           test = file.exists(file.path(snakemake@config$workdir, "Assembly", "assembly", paste0(.sample, ".fasta"))),
                           yes = file.path(snakemake@config$workdir, "Assembly", "assembly", paste0(.sample, ".fasta")),
                           no = as.character(NA)))) %>% 
  set_names(x = ., nm = map_chr(.x = names(.),  # translate names with LIMS-compatible name dictionary
                                .f = function(.name)ifelse(
                                  test = .name %in% names(jsonNames_to_exportNames),
                                  yes = jsonNames_to_exportNames[.name],
                                  no = .name))) %>% 
  write_tsv(file = file.path(snakemake@config$workdir, snakemake@params[["tsv_report"]]))

stats_selected_qc %>%  # no LIMS-compatible name translation here, b/c values are written back to sample JSON
  rename_all(.funs = ~ gsub("\\.score$", "", .)) %>%
  write_tsv(file = file.path(snakemake@config$workdir, snakemake@params[["tsv_qc_vote"]]))

```

```{r format_DataTables, echo = FALSE}

results_col_round0 <- c(
  "reads_total",
  "# contigs (>= 0 bp)",
  "# contigs (>= 1000 bp)",
  "N50",
  "genes_full",
  "genes_partial",
  "Total length",
  "Reference length",
  "insert_mean"
)

results_col_round1 <- c(
  "base_count",
  "assembly_coverageDepth"
)

results_col_round3 <- c(
  "q30_rate_after",
  "read_hit1_species_fraction",
  "read_hit1_genus_fraction",
  "contig_hit1_species_fraction",
  "contig_hit1_genus_fraction",
  "busco_single",
  "busco_duplicates",
  "fraction_genes_recovered",
  "Genome fraction (%)",
  "fraction",
  "fraction_reads_mapped"
)

```

# Assembly report for run `r run` {.tabset}

## Overview

* Run name: `r runName`
* Number of completed samples: `r nrow(stats)`
* Number of pipeline fails: `r length(fails)`
* Number of QC fails: `r qc_fails`
* Working directory: `r snakemake@config$workdir`
* Location of trimmed fastq files: `r file.path(snakemake@config$workdir, "trimmed")`
* Location of fasta files: `r file.path(snakemake@config$workdir, "Assembly", "assembly")`

### Pipeline execution fails

Pipeline execution failed for `r length(fails)` samples.

```{r fails, echo = FALSE, message = FALSE}

if (length(fails) == 0) {
  print("No samples failed.")
} else {
  samples_failed <- samples_pre_assembly[samples_pre_assembly %in% fails]
  modules_fail_check <- c("confindr", "assembly", "mash", "reference", "quast")
  
  fails_df <- map_dfr(
    .x = samples_failed,
    .f = function(.sample){
      pipeline_modules_passed <- tibble(
        sample    = .sample,
        # confindr  = file.exists(file.path(snakemake@config$workdir, "confindr", .sample, "confindr_report.csv")),  # TODO: this could also be BasesExamined > 0; Bases Examined always > 0 if no genus found, inter, intra, no contam??
        confindr  = !(sum(read_csv(file.path(snakemake@config$workdir, "confindr", .sample, "confindr_report.csv"), col_types = cols()) %in% "ND") == 7), # TODO confindr never ends up here because they do NOT fail
        assembly  = file.exists(file.path(snakemake@config$workdir, "Assembly", "assembly", paste0(.sample, ".fasta"))),
        mash      = file.exists(file.path(snakemake@config$workdir, "Assembly", .sample, "mash_best.dist")),
        reference = file.exists(file.path(snakemake@config$workdir, "Assembly", .sample, "ref", paste0("reference", ".fasta"))),
        quast     = file.exists(file.path(snakemake@config$workdir, "Assembly", .sample, "quast", "report.tsv"))
      )
      
      if (pipeline_modules_passed$assembly) {
        comment_assembly <- paste("Assembly succesful:", file.path(snakemake@config$workdir, "Assembly", "assembly", paste0(.sample, ".fasta")))
      } else {
        comment_assembly <- paste("Assembly NOT succesful! Likely reasons: Low coverage or complex sample. See",
                                  file.path(snakemake@config$workdir, "Assembly", .sample, "shovill.log"),
                                  "for details")
      }
      
      if (!pipeline_modules_passed$reference & pipeline_modules_passed$assembly) {
        mash_path <- file.path(snakemake@config$workdir, "Assembly", .sample, "mash_best.dist")
        if (file.exists(mash_path)) {
          best_hit <- gsub(pattern = ".fasta", replacement = "" , x = readr::read_tsv(file = mash_path, col_names = FALSE)[[1]][[1]])  #  col_names = c("reference", "query","distance","pvalue","shared_sketches","total_sketches")
        } else {
          best_hit <- NA
        }
        comment_reference <- paste("Reference file not present.",
                                   "Possibly no connection to NCBI could be established.",
                                   "Possible solution: Set proxy, run download command (see logfiles) manually or re-run aquamis at a later stage.",
                                   "Also, check if first entry in", mash_path, "exists:", best_hit)
      } else if (!pipeline_modules_passed$quast & pipeline_modules_passed$assembly) {
        comment_reference <- paste("Problems running quast, see",
                                   file.path(snakemake@config$workdir, "Assembly", .sample, "quast", "quast.log"),
                                   "for details")
      } else {
        comment_reference <- ""
      }
      
      if (!pipeline_modules_passed$confindr) {
        confindr_log <- file.path(snakemake@config$workdir, "confindr", .sample, "confindr_log.txt")
        comment_confindr <- paste("Confindr results missing. Problem with confindr scheme? See", confindr_log)
      } else {
        comment_confindr <- ""
      }
      
      commments <- c(comment_confindr, comment_reference, comment_assembly)
      pipeline_modules_passed$comment <- paste(commments[commments != ""], collapse = "; ")
      return(pipeline_modules_passed)
    }) %>% 
    mutate_at(.vars = vars(any_of(modules_fail_check)),
              .funs = ~ factor(x = .,
                               levels = c(FALSE, TRUE),
                               labels = c("FAIL", "PASS")))
  
  DT::datatable(fails_df,
                filter = 'top',
                rownames = FALSE,
                escape = FALSE, 
                extensions = list("Buttons" = NULL),
                options = list(dom = 'BRrltpi',
                               autoWidth = FALSE,
                               scrollX = TRUE,
                               lengthMenu = list(
                                 c(5, 10, 50, -1),
                                 c("5", "10", "50", "All")),
                               pageLength = 10,
                               buttons = list(
                                 list(extend = 'copy',
                                      title = NULL,
                                      exportOptions = list(columns = ":visible")),
                                 list(extend = 'print',
                                      title = NULL,
                                      exportOptions = list(columns = ":visible")),
                                 list(text = 'Download',
                                      extend = 'collection',
                                      title = NULL,
                                      buttons = list(list(extend = 'csv',
                                                          title = NULL,
                                                          exportOptions = list(columns = ":visible")),
                                                     list(extend = 'excel',
                                                          title = NULL,
                                                          exportOptions = list(columns = ":visible")),
                                                     list(extend = 'pdf',
                                                          title = NULL,
                                                          exportOptions = list(columns = ":visible")))),
                                 I('colvis'))
                )) %>% 
    formatStyle(
      table = .,
      target = "cell",
      columns = modules_fail_check,
      valueColumns = modules_fail_check,
      backgroundColor = styleEqual(levels = c("FAIL", "PASS"), values = c("#E07A5F", "#81B294")))
}

```

For more details, have a look at the log files in `r file.path(snakemake@config$workdir, "logs")`.

## Short summary table

```{r short_summary}

datatable(stats_selected_short_full,
          filter = 'top',
          colnames = map_chr(.x = names(stats_selected_short_full),
                             .f = ~ ifelse(test = . %in% names(jsonNames_to_tableNames),
                                           yes = jsonNames_to_tableNames[.],
                                           no = .)),
          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(5, 10, 50, -1),
                           c("5", "10", "50", "All")),
                         pageLength = 10,
                         ColReorder = TRUE,
                         columnDefs = list(list(
                           visible = FALSE,
                           targets = grep(".score|.color", names(stats_selected_short_full)) - 1)),
                         buttons = list(
                           list(extend = 'copy',
                                title = NULL,
                                exportOptions = list(columns = ":visible")),
                           list(extend = 'print',
                                title = NULL,
                                exportOptions = list(columns = ":visible")),
                           list(text = 'Download',
                                extend = 'collection',
                                title = NULL,
                                buttons = list(list(extend = 'csv',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")),
                                               list(extend = 'excel',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")),
                                               list(extend = 'pdf',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")))),
                           I('colvis'))
          )) %>%
  formatRound(
    columns = intersect(results_col_round0, names(stats_selected_short_full)),
    digits = 0) %>%
  formatRound(
    columns = intersect(results_col_round1, names(stats_selected_short_full)),
    digits = 1) %>%
  formatRound(
    columns = intersect(results_col_round3, names(stats_selected_short_full)),
    digits = 3) %>%
  formatStyle(
    table = .,
    target = "cell",
    columns = thresholds_intersect_short,
    valueColumns = paste0(thresholds_intersect_short, ".color"),
    backgroundColor = styleValue())

```

## Detailed assembly table

The table is searchable and sortable. At the end, clickable links are provided to the created fasta file, to the best ncbi reference contig and to the quast and icarus reports.

Note that the best reference is selected from the set of all complete bacterial chromosome assemblies. Hence plasmids are excluded which in turn might reflect in a larger genome length of the sample than the reference.
Futhermore, for bacteria with more than one chromosome, only the best matching chromosome is reported. Thus gene count, reference length etc. are properties of the best matching chromosome.

```{r detailed_assembly_summary}

datatable(data = stats_selected_full,
          filter = 'top',
          colnames = map_chr(.x = names(stats_selected_full),
                             .f = ~ ifelse(test = . %in% names(jsonNames_to_tableNames),
                                           yes = jsonNames_to_tableNames[.],
                                           no = .)),
          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(5, 10, 50, -1),
                           c("5", "10", "50", "All")),
                         pageLength = 10,
                         ColReorder = TRUE,
                         columnDefs = list(list(
                           visible = FALSE,
                           targets = grep(".score|.color", names(stats_selected_full)) - 1)),
                         buttons = list(
                           list(extend = 'copy',
                                title = NULL,
                                exportOptions = list(columns = ":visible")),
                           list(extend = 'print',
                                title = NULL,
                                exportOptions = list(columns = ":visible")),
                           list(text = 'Download',
                                extend = 'collection',
                                title = NULL,
                                buttons = list(list(extend = 'csv',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")),
                                               list(extend = 'excel',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")),
                                               list(extend = 'pdf',
                                                    title = NULL,
                                                    exportOptions = list(columns = ":visible")))),
                           I('colvis'))
          )) %>%
  formatRound(
    columns = intersect(results_col_round0, names(stats_selected_full)),
    digits = 0) %>%
  formatRound(
    columns = intersect(results_col_round1, names(stats_selected_full)),
    digits = 1) %>%
  formatRound(
    columns = intersect(results_col_round3, names(stats_selected_full)),
    digits = 3) %>%
  formatStyle(
    table = .,
    target = "cell",
    columns = thresholds_intersect,
    valueColumns = paste0(thresholds_intersect, ".color"),
    backgroundColor = styleValue())

```

## Detailed trimming table

```{r fastp}

datatable(fastp_data,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          ))


```

## Taxonomy results

Three most abundant __species__ according to __read__-based taxonomic classification with _kraken2_ and abundance estimation with braken based on the kraken2 minikraken database.

```{r kraken2_reads_species}

datatable(kraken2_reads_species,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          ))

```

Three most abundant __species__ according to __contig__-based taxonomic classification with _kraken2_ based on the kraken2 minikraken database.

```{r kraken2_contigs_species}

datatable(kraken2_contigs_species,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          ))

```

Three most abundant __genus__ according to __read__-based taxonomic classification with _kraken2_ and abundance estimation with braken based on the kraken2 minikraken database.

```{r kraken2_reads_genus}

datatable(kraken2_reads_genus,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          ))

```

Three most abundant __genus__ according to __contig__-based taxonomic classification with _kraken2_ based on the kraken2 minikraken database.

```{r kraken2_contigs_genus}

datatable(kraken2_contigs_genus,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          ))

```

## Contamination results

Inter and intra species contamination is assessed using _confindr_. Sound intra-species contamination is performed using a genus specific cgMLST approach. 
A sample is marked as contaminated if either more than 1 contaminating SNV per 10000 base pairs examined was found - or there is cross contamination between genera. Missing values were not determined (ND).

```{r confindr}

datatable(confindr,
          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(5, 10, 50, -1),
              c("5", "10", "50", "All")),
            pageLength = 10,
            ColReorder = TRUE,
            searchHighlight = TRUE,
            scrollCollapse = TRUE,
            buttons = list(
              list(extend = 'copy',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(extend = 'print',
                   title = NULL,
                   exportOptions = list(columns = ":visible")),
              list(text = 'Download',
                   extend = 'collection',
                   title = NULL,
                   buttons = list(list(extend = 'csv',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'excel',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")),
                                  list(extend = 'pdf',
                                       title = NULL,
                                       exportOptions = list(columns = ":visible")))),
              I('colvis'))
          )) %>%
  formatStyle(
    table = .,
    target = "cell",
    columns = "BasesExamined",
    valueColumns = "BasesExamined",
    backgroundColor = styleInterval(cuts = c(0), values = c("#E07A5F", "#FFFFFF")))

```


*    Sample: The name of the sample. ConFindr will take everything before the first underscore (_) character to be the name of the sample, as done with samples coming from an Illumina MiSeq.
*    Genus: The genus that ConFindr thinks your sample is. If ConFindr couldn't figure out what genus your sample is from, this will be NA. If multiple genera were found, they will all be listed here, separated by a :
*    NumContamSNVs: The number of times ConFindr found sites with more than one base present.
*    ContamStatus: The most important of all! Will read True if contamination is present in the sample, and False if contamination is not present. The result will be True if any of the following conditions are met:
More than 1 contaminating SNV per 10000 base pairs examined was found.
There is cross contamination between genera.
*    PercentContam: Based on the depth of the minor variant for sites with multiple bases, ConFindr guesses at what percent of your reads come from a contaminant. The more sequencing depth you have, the more accurate this will get. For lower levels of contamination (around 5 percent) this tends to get overestimated, but the number gets more accurate as contamination level increases, as well as sequencing depth.
*    PercentContamStandardDeviation: The standard deviation of the percentage contamination estimate. Very high values may indicate something strange is going on.
*    BasesExamined: The number of bases ConFindr examined when making the contamination call. Will usally be around 20kb for rMLST databases, and will vary when other databases are used.
*    DatabaseDownloadDate: Date that rMLST databases were downloaded, if you have them. As these are curated and updated regularly, it's a good idea to re-run confindr_database_setup every now and then.


## Plots per run

### Coverage depth

```{r plots_assembly_coverage, echo = FALSE, out.width = '80%', fig.asp = 0.5, fig.align = 'center', fig.cap = "Figure 1: Average assembly coverage depth of all mapped reads (per sample).", fig.retina = 4}

ggplot(data = stats, aes(x = sample, y = assembly_coverageDepth)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
  ggtitle("Assembly coverage") +
  xlab("Sample") +
  ylab ("Average assembly coverage")

```

### Fraction of recovered reference genes

```{r plots_reference_genes_covered, echo = FALSE, out.width = '80%', fig.asp = 0.5, fig.align = 'center', fig.cap = "Figure 2: Fraction of reference genes fully or partially found in assembly. Note that if a genome consists of more than one chromosome, only the fraction beloning to the largest chromosome is displayed.", dpi = 384}

ggplot(data = stats, aes(x = sample, y = fraction_genes_recovered)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
  ggtitle("Fully or partially recovered genes") +
  xlab("Sample") +
  ylab ("Fraction of recovered genes")

```

### Fraction of reads mapped to contigs

```{r plots_reads_mapped, echo = FALSE, out.width = '80%', fig.asp = 0.5, fig.align = 'center', fig.cap = "Figure 3: Fraction of reads that map back to the assembly. A lower fraction indicates problems with the assembly and/or contamination in a sample."}

ggplot(data = stats, aes(x = sample, y = fraction_reads_mapped)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
  ggtitle("Reads mapped to assembly") +
  xlab("Sample") +
  ylab ("Fraction of mapped reads")

```

### Insert size distribution

```{r plots_insertsize, echo = FALSE, fig.cap = "Figure 4: Insert size distrubution per sample (violin plot). The mean insert sizes are indicated by red diamonds. The insert size is the same as the fragment size without barcodes. Thus, if the insert size is smaller than two times the read length, the reads overlap."}

json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "samstats", "insert_size"),
                 .id = "sample") %>% 
  as_tibble() %>%
  group_by(sample) %>% 
  mutate(size = map2(.x = insert_size,
                     .y = count,
                     .f = ~ rep(x = .x, times = .y))) %>%
  select(sample, size) %>% 
  unnest(cols = size) %>%
  sample_frac(size = 0.01, replace = FALSE) %>%
  ggplot(data = .,
         mapping = aes(x = sample,
                       y = size)) +
  geom_violin() +
  stat_summary(fun = mean,
               geom = "point",
               shape = 23,
               size = 2,
               col = 2) +
  theme(axis.text.x = element_text(angle = 60,
                                   hjust = 1)) +
  ggtitle("Insert size distribtution (violin graph)") +
  xlab("Sample") +
  ylab ("Insert size")

```

******

### Coverage depth distribution

```{r plots_coverage_violin, echo = FALSE, fig.cap = "Figure 6: Coverage depth distribution of each sample(violin graph), in logscale. Each separate bubble indicates the presence of a DNA molecule with a defined coverage depth distribition. Hence, the presence of more than one bubble may be associated with the presence of (high copy number) plasmids." }

json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "samstats", "coverage"),
                 .id = "sample") %>% 
  as_tibble() %>% 
  group_by(sample) %>% 
  filter(coverage_bin < 1000) %>%  # Coverage.cutoff
  mutate(data_counts = map2(.x = coverage_bin,
                            .y = floor(log2(frequency)),
                            .f = ~ rep(x = .x, times = .y))) %>%
  select(sample, data_counts) %>% 
  unnest(cols = data_counts) %>% 
  ggplot(data = .,
         mapping = aes(x = sample,
                       y = data_counts)) +
  geom_violin() +
  theme(axis.text.x = element_text(angle = 60,
                                   hjust = 1)) +
  ggtitle("Coverage depth distribution (violin graph), in logscale") +
  xlab("Sample") +
  ylab("Coverage depth")

```

## Plots per sample

### Coverage depth distribution

In the following, the coverage depth distribution is shown for each sample (in log scale):

```{r plots_persample, echo = FALSE}

.plotdata <- json_sample_obj_post %>%
  purrr::map_dfr(.x = .,
                 .f = function(.x)purrr::pluck(.x = .x, "pipelines", "samstats", "coverage"),
                 .id = "sample") %>% 
  as_tibble() %>% 
  group_by(sample)

.plotdata <- .plotdata %>%
  group_split(.keep = FALSE) %>%
  set_names(unlist(group_keys(.plotdata)))

.plotlist <- map(.x = .plotdata,
                 .f = function(.sample)ggplot(
                   data = .sample,
                   mapping = aes(x = coverage_bin,
                                 y = frequency)) +
                   geom_line() +
                   scale_y_continuous(trans = 'log10') +
                   coord_cartesian(xlim = c(0, 1000)) +  # Coverage.cutoff
                   # facet_wrap(facets = vars(sample), ncol = 1) +
                   ggtitle("Coverage histogram of sample") +
                   xlab("Coverage depth") +
                   ylab("Count (logscale)"))

.plotlist

```

## Program versions/ log

### Parameters

* All parameter setting can be found in the config file: `r file.path(snakemake@config$workdir, "config.yaml")`.
* program versions are available in the conda env files


```{r parameters}

str(object = snakemake@config,
    give.attr = FALSE,
    give.head = FALSE,
    comp.str = "",
    indent.str = "  ",
    no.list = TRUE)

```

### Software versions

* main programs are fastp, confindr, shovill/spades, mash, quast

```{r software versions}

software_versions.file <- snakemake@params[["software_versions"]]

if(file.exists(software_versions.file)){
  software_versions <- read.delim(software_versions.file, stringsAsFactors = F)
  knitr::kable(software_versions)
} 

```


### Logging

* snakemake logs: * config file: `r file.path(snakemake@config$workdir, ".snakemake")`.
* logfiles in folder `r file.path(snakemake@config$workdir, "logs")`.


## Help

```{r help}

knitr::kable(enframe(x = help, name = "Column", value = "Details"))

```
