---
title: "Phylogenetic linear modeling results"
output: 
  html_document:
    toc: true
    toc_float: true
    keep_md: true
    self_contained: true
params:
  ncl: 1
  source_dir: "."
  out_dir: "."
  in_dir: "."
  assume_below_LOD: TRUE
  skip_graphs: FALSE
  use_rmd_params: TRUE
  error_to_file: TRUE
---

```{r setup, warning=FALSE, message=FALSE, results="hide", echo=FALSE, cache=FALSE}

library(phylogenize)
library(Matrix)

cache.d <- file.path(pz.options('out_dir'), 'cache')
dir.create(pz.options('out_dir'))
dir.create(cache.d)
knitr::opts_chunk$set(cache.path=cache.d)

if (pz.options('use_rmd_params')) {
    do.call(pz.options, args=params)
}

if (is.null(pz.options('relative_out_dir'))) {
  pz.options(relative_out_dir=pz.options('out_dir'))
}

# Note that params give defaults for the web tool, while PZ_OPTIONS gives
# defaults for the package

# set graphing hook
if (!pz.options('skip_graphs')) {
    library(svglite)
    knitr::knit_hooks$set(custom.plot = knitr::hook_plot_custom)
    # Thanks to Yihui Xie:
    # https://github.com/yihui/knitr/issues/754#issuecomment-40540980
    local({
        hook_plot = knitr::knit_hooks$get('plot')
        knitr::knit_hooks$set(plot = function(x, options) {
            x = paste(x, collapse = '.')
            if (!grepl('\\.svg', x)) return(hook_plot(x, options))
            if (file.exists(x)) {
              paste(readLines(x)[-1], collapse = '\n')
            } else {
              paste("<!-- file not found: ",
                    x,
                    " -->",
                    sep = '',
                    collapse = '')
            }
        })
    })
}

dir.create(pz.options('out_dir'))
do_POMS <- (tolower(pz.options('core_method'))=="poms")

```

# Settings

This report was generated automatically by [Phylogenize2](https://phylogenize.org/) (Kananen et al., in preparation), with the following parameters:

- Type of input data: "`r pz.options('db')`"
- Phenotype calculated: "`r pz.options('which_phenotype')`"
- Environment of interest: "`r pz.options('which_envir')`"
- Prior probabilities for environments: "`r pz.options('prior_type')`"

# Phenotypic Calculation

Below, trees for all taxa with at least `r pz.options('treemin')`
representatives in the input data are presented. Trees are colored according to
the phenotype chosen (here, `r pz.options('which_phenotype')` in the environment
 `r pz.options('which_envir') `).

For prevalence, the tree is colored black (low prevalence) to orange (high
prevalence). For specificity, the tree is colored red for taxa that are
specific for an environment, blue for taxa that are specific for other
environments (i.e., found less often in the environment chosen), and gray for
taxa that are neither.

## Distribution of Phenotype {.tabset}
```{r plot_phenotypes, fig.width = 7, fig.height = 20, warning = FALSE, message = FALSE, results="hide", echo=FALSE, cache=FALSE}

# Unpack pz.db and phenotype results to current environment
list2env(core[["list_pheno"]], environment())
# Also unpack "phenotype, phenoP, mapped.observed" into current environment
list2env(core[["list_pheno"]][["phenotype_results"]], environment())

pheno.distros <- plot.pheno.distributions(phenotype, pz.db)
pheno.scale <- get.pheno.plotting.scales(phenotype, pz.db$trees, phenoP)
plotted.pheno.trees <- plot.phenotype.trees(phenotype, pz.db$trees, pz.db$taxonomy, pheno.scale)

# Template for plots
template <- c(
    "### Page {{nm}}\n",
    "```{r, echo = FALSE, warning = FALSE, message = FALSE}\n",
    "pheno.distros[[{{nm}}]]\n",
    "```\n",
    "\n"
)

plots <- lapply(1:length(pheno.distros), function(nm) {
    knitr::knit_expand(text = template, nm = nm)
})

write.table(file=file.path(pz.options('out_dir'), "phenotype.tab"),
            phenotype,
            sep = '\t')

# be a little parsimonious with memory here
gc()
```
`r knitr::knit_child(text = unlist(plots), quiet = TRUE)`
## Phenotype Mapped Across Trees {.tabset}
### All Taxa
```{r plot_phenos_on_trees, echo=FALSE, warning = FALSE, results='asis', cache=FALSE}

plots <- list()
if (!pz.options('skip_graphs')) {
	plots <- plot.labeled.phenotype.trees(plotted.pheno.trees,
				     100*logistic(phenotype),
				     label=pz.options('which_phenotype'))
}

phylogenize::knitPrintListPlots(
	plotsList = plots, 
	type = "plotly", 
	titles = NULL, 
	titleLevel = NULL
)

```

### Only Mapped/Observed Taxa
```{r plot_phenos_on_observed_trees, echo=FALSE, warning=FALSE, results='asis', warning = FALSE, message = FALSE, cache=FALSE}

pheno.labels <- names(phenotype)
subtrees <- lapply(pz.db$trees, function(tr) {
  keep.tips(tr, intersect(mapped.observed, pheno.labels))
})

subtrees <- Filter(function(x) {
  if (is.null(x)) return(FALSE)
  if (length(x$tip.label) > 2) return(TRUE)
  return(FALSE)
}, subtrees)

subplots <- list()
if (!pz.options('skip_graphs')) {
       plotted.pheno.subtrees <- plot.phenotype.trees(phenotype, subtrees, pz.db$taxonomy, pheno.scale)
       subplots <- plot.labeled.phenotype.trees(plotted.pheno.subtrees,
						 100*logistic(phenotype),
						 label=pz.options('which_phenotype')
				     )
}

phylogenize::knitPrintListPlots(
        plotsList = subplots,
        type = "plotly",
        titles = NULL,
        titleLevel = NULL
)

```
# Gene Associations and Significance
Analysis of the genes associated to taxa including their significance, presence/absence 
of a gene, and enrichment analysis.

## Associations between genes and taxa
This table gives an overview of how many genes were significantly associated at
an FDR of 5%.

```{r write_associations, warning = FALSE, message = FALSE, echo=FALSE, cache=FALSE}

signif_genes <- core[["list_signif"]]

pos.sig <- data.frame(
  Taxon = names(signif_genes[["pos.sig"]]),
  `Significant Genes` = sapply(signif_genes[["pos.sig"]], length),
  row.names = NULL
)
phylogenize::getClinDT(pos.sig)

write.csv(file = file.path(pz.options('out_dir'), "pos-sig-thresholded.csv"),
	  signif_genes[["pos.sig.descs"]])
write.csv(file = file.path(pz.options('out_dir'), "all-results.csv"),
          signif_genes[["results.matrix"]])

```
## Gene association heat maps
The left shows the phenotype painted on tips of the tree as above. The right
adds a heatmap where blue points represent presence of a gene (aligned with the
tips of the tree) and white points represent absence. Only
significantly-associated genes are displayed. Genes are clustered from left to
right by Jaccard dissimilarity, so genes with similar patterns of inheritance
will form vertical stripes. Horizontal stripes may be visible for taxa that
have particularly extreme phenotypes.

```{r gene_assoc_heat_maps, warning = FALSE, message = FALSE, echo=FALSE, results="hide", dev = "png", dpi = 300, cache=FALSE}
valid_keys <- intersect(signif_genes[["phy.with.sigs"]], names(plotted.pheno.trees))
valid_keys <- intersect(valid_keys, names(pz.db$gene.presence))
valid_keys <- intersect(valid_keys, names(pz.db$trees))

cluster.plots <- mapply(do.clust.plot,
                        pz.db$gene.presence[valid_keys],
                        signif_genes[["pos.sig.thresh"]][valid_keys],
                        pz.db$trees[valid_keys],
                        plotted.pheno.trees[valid_keys],
                        valid_keys,
                        SIMPLIFY = FALSE)

```

## Enrichment analysis

This process takes the set of genes that are significant and positively
associated with the phenotype, then asks whether there are more than expected
by chance in a given KEGG module or pathway. This requires clusterProfiler to
be installed.

All pathways/modules returned are significant at an FDR of 25%. "Strong", "Med",
and "Weak" refer to per-gene significance cutoffs of 5%, 10%, and 25%,
respectively.

```{r enrichment_tables, warning = FALSE, message = FALSE, echo=FALSE, cache=FALSE, results='axsis'}
do_enrichment <- ("enr_tbls" %in% names(core))
if (do_enrichment) {
    table <- phylogenize::getClinDT(core[["enr_tbls"]]) |>
        DT::formatStyle(
            'q_value',
            target = 'row',
            backgroundColor = DT::styleInterval(0.05, c('lightgreen', NA))
        ) |>
        DT::formatSignif(
            c('q_value', 'Enrichment_odds_ratio'),
            digits=2
        )
    table
} else {
    pz.message(
        "Skipping enrichment as tables could not be found in provided object"
    )
}
```

# Full output files

Links to other files generated by the report:

```{r, results='asis', echo=FALSE}

if (is.null(pz.options('relative_out_dir'))) {
  r.outdir <- pz.options('out_dir')
} else {
  r.outdir <- pz.options('relative_out_dir')
}
for (f in c("phenotype.tab",
            "all-results.csv",
            "pos-sig-thresholded.csv",
            "enr-table.csv",
            "enr-overlaps.csv",
            "enr-overlaps-sorted.csv")) {
  fp <- file.path(r.outdir, f)
  # Note, check the actual output directory when we're trying to figure out what
  # got made
  if (file.exists(file.path(pz.options('out_dir'), f))) {
    cat(paste0(' * [**', f, '**](', fp, ')\n'))
  }
}
```
