---
## Alternatively, use the DESeqAnalysis package for complex contrasts.
## Updated 2020-07-08.
params:
  title: "Differential expression with DESeq2"
  ## bcbioRNASeq object.
  bcb_file: "rds/YYYY-MM-DD/bcb.rds"
  ## Design formula must contain columns defined in `colData()`.
  design: !r formula("~ group")
  ## Multiple contrasts are supported here.
  contrasts: !r list(
      c(
        factor = "group",
        numerator = "B",
        denominator = "A"
      )
    )
  alpha: 0.01
  lfc_threshold: 0
  data_dir: !r file.path("data", Sys.Date())
  results_dir: !r file.path("results", Sys.Date(), "differential-expression")
title: "`r params$title`"
author: "`r getOption('author')`"
date: "`r Sys.Date()`"
bibliography: bibliography.bib
---

```{r setup, cache=FALSE, message=FALSE}
library(bcbioRNASeq)
library(DESeq2)
library(DESeqAnalysis)
prepareTemplate()
source("_setup.R")
```

```{r dir-create}
invisible(mapply(
    FUN = dir.create,
    path = c(params$data_dir, params$results_dir),
    MoreArgs = list(showWarnings = FALSE, recursive = TRUE)
))
```

```{r header, child="_header.Rmd"}
```

# Load bcbioRNASeq object

```{r load-object}
file <- params$bcb_file
object <- import(file)
name <- basenameSansExt(file)
rm(file)
stopifnot(
    is(object, "bcbioRNASeq"),
    is.character(name)
)
invisible(validObject(object))
print(object)
```

# Create DESeqDataSet

Here we are using an S4 coercion method to convert our `bcbioRNASeq` object to a `DESeqDataSet`. This prepares a gene-level `RangedSummarizedExperiment` with raw integer counts defined in the `assay()` slot. Internally this uses the `DESeqDataSet()` constructor function and sets an empty design formula. The desired design formula can be set with the `design()` function.

```{r coerce-bcb-to-dds}
## Coerce bcbioRNASeq to DESeqDataSet.
## > help("coerce", "bcbioRNASeq")
## > getMethod(
## >     f = "coerce",
## >     signature = signature(
## >         from = "bcbioRNASeq",
## >         to = "DESeqDataSet"
## >     )
## > )
dds <- as(object, "DESeqDataSet")
stopifnot(is(dds, "DESeqDataSet"))
invisible(validObject(dds))
print(dds)
```

# Design

The design formula, specified with the `design()` function, must contain factor columns in `colData()` / `sampleData()`.

Ensure that all relevant factor columns in `sampleData()` contain valid names (see `make.names()` for details) prior to setting the design. We recommend using the `snakeCase()` function to automatically sanitize all factors into snake case.

```{r design}
## > colnames(colData(dds))
design(dds) <- params$design
```

# Pre-filtering

While it is not necessary to pre-filter low count genes before running the DESeq2 functions, there are two reasons which make pre-filtering useful: by removing rows in which there are very few reads, we reduce the memory size of the dds data object, and we increase the speed of the transformation and testing functions within DESeq2. Here we perform a minimal pre-filtering to keep only rows that have at least 10 reads total. Note that more strict filtering to increase power is automatically applied via independent filtering on the mean of normalized counts within the `results()` function.

```{r prefilter, eval=FALSE}
## Note that this criteria can be made more stringent.
## Refer to DESeq2 vignette for examples.
keep <- rowSums(counts(dds)) >= 10
dds <- dds[keep, ]
print(dds)
```

# Factor reference level

By default, [R][] will choose a reference level for factors based on alphabetical order. Then, if you never tell the [DESeq2][] functions which level you want to compare against (e.g. which level represents the control group), the comparisons will be based on the alphabetical order of the levels. There are two solutions: you can either explicitly tell results which comparison to make using the contrast argument (this will be shown later), or you can explicitly set the factors levels. You should only change the factor levels of variables in the design before running the [DESeq2][] analysis, not during or afterward. Setting the factor levels can be done in two ways, using either the `factor()` or `relevel()` functions. Generally we recommend using `relevel()` here.

```{r relevel, eval=FALSE}
## Including this code here for reference only.

## Specify the reference level (preferred).
dds$treatment <- relevel(dds$group, ref = "control")

## Alternatively, can explicitly define, using `factor()`.
## When using this approach, put the reference level (control) first.
dds$treatment <- factor(dds$group, levels = c("treatment", "control"))

## If samples have been subset, ensure that the levels match.
dds$treatment <- droplevels(dds$group)
```

# Differential expression analysis

Now that our `DESeqDataSet` is properly set up, we can move on to performing the differential expression. The standard differential expression analysis steps for [DESeq2][] are wrapped into a single function, `DESeq()`. Results tables are generated using the function `results()`, which extracts a results table with log2 fold changes, *P* values and adjusted *P* values. With no additional arguments to `results()`, the log2 fold change and Wald test *P* value will be for the last variable in the design formula (`design()`), and if this is a factor, the comparison will be the last level of this variable over the reference level (see previous note on factor levels). However, the order of the variables of the design do not matter so long as the user specifies the comparison to build a results table for, using the name or contrast arguments of results.

```{r deseq}
dds <- DESeq(dds)
assignAndSaveData(
    name = paste(name, "dds", sep = "_"),
    object = dds,
    dir = params$data_dir
)
```

# Variance stabilization

After we perform the differential expression, we need to calculate variance-stabilized counts, which are stored in a `DESeqTransform` object. These transformed counts are useful for visualization. We currently recommend using `varianceStabilizingTransformation()` but `rlog()` is a good alternate.

```{r variance-stabilization}
## Alternatively, can use `rlog()` here instead, but it is slower.
dt <- varianceStabilizingTransformation(dds)
stopifnot(is(dt, "DESeqTransform"))
interestingGroups(dt) <- "treatment"
invisible(validObject(dt))
assignAndSaveData(
    name = paste(name, "dt", sep = "_"),
    object = dt,
    dir = params$data_dir
)
```

# Results

For contrast argument as character vector:

1. Design matrix factor of interest.
2. Numerator for LFC (expt).
3. Denominator for LFC (control).

```{r contrasts}
## factor; numerator; denominator
## > levels(dds$genotype)
## > help("results", "DESeq2")
stopifnot(is.list(params$contrasts))
contrasts <- params$contrasts
names <- vapply(
    X = contrasts,
    FUN = function(x) {
        paste(x[[1]], x[[2]], "vs", x[[3]], sep = "_")
        
    },
    FUN.VALUE = "character"
)
names(contrasts) <- names
print(contrasts)
```

```{r res-unshrunken}
res_list_unshrunken <- mapply(
    FUN = results,
    contrast = contrasts,
    MoreArgs = list(
        object = dds,
        alpha = params$alpha,
        lfcThreshold = params$lfc_threshold
    ),
    SIMPLIFY = FALSE,
    USE.NAMES = FALSE
)
names(res_list_unshrunken) <- names
assignAndSaveData(
    name = paste(name, "res_list_unshrunken", sep = "_"),
    object = res_list_unshrunken,
    dir = params$data_dir
)
```

Now let's calculate shrunken log2 fold change values with `DESeq2::lfcShrink()`. We're using the "normal" shrinkage estimator (default in DESeq2); the "apeglm" shrinkage estimator is also promising but doens't work well with complex contrast designs.

```{r res-shrunken}
## Refer to DESeqAnalysis package if you want to use apeglm instead.
res_list_shrunken <- mapply(
    FUN = lfcShrink,
    res = res_list_unshrunken,
    contrast = contrasts,
    MoreArgs = list(
        dds = dds,
        type = "normal",
        alpha = params$alpha,
        lfcThreshold = params$lfc_threshold
    ),
    SIMPLIFY = FALSE,
    USE.NAMES = TRUE
)
assignAndSaveData(
    name = paste(name, "res_list_shrunken", sep = "_"),
    object = res_list_shrunken,
    dir = params$data_dir
)
```

Let's save a copy of the prior information used during the shrinkage procedure.

```{r prior-info}
lapply(X = res_list_shrunken, FUN = priorInfo)
```

We performed the analysis using a BH adjusted *P* value cutoff of `r params$alpha` and a log fold-change (LFC) ratio cutoff of `r params$lfc_threshold`.

# Plots

## Mean average (MA)

An MA plot compares transformed counts on `M` (log ratio) and `A` (mean average) scales [@Yang2002-sx].

```{r plot-ma}
lapply(X = res_list_shrunken, FUN = plotMA)
```

## Volcano

A volcano plot compares significance (BH-adjusted *P* value) against fold change (log2) [@Cui2003-rn; @Li2014-ll]. Genes in the green box with text labels have an adjusted *P* value are likely to be the top candidate genes of interest.

```{r plot-volcano}
lapply(X = res_list_shrunken, FUN = plotVolcano)
```

## PCA

```{r plot-deg-pca}
mapply(
    FUN = plotDEGPCA,
    object = res_list_shrunken,
    MoreArgs = list(
        DESeqTransform = dt,
        label = FALSE
    ),
    SIMPLIFY = FALSE
)
```

## Heatmap

This plot shows only differentially expressed genes on a per-sample basis. We have scaled the data by row and used the `ward.D2` method for clustering [@Ward1963-xf].

```{r plot-deg-heatmap}
invisible(mapply(
    FUN = plotDEGHeatmap,
    object = res_list_shrunken,
    MoreArgs = list(
        DESeqTransform = dt,
        clusteringMethod = "ward.D2",
        scale = "row"
    ),
    SIMPLIFY = FALSE
))
```

## Top tables

Only the top up- and down-regulated genes (arranged by log2 fold change) are shown.

```{r top-tables, results="asis"}
invisible(mapply(
    FUN = topTables,
    object = res_list_shrunken,
    MoreArgs = list(
        DESeqDataSet = dds,
        n = 20L
    )
))
```

# Export results tables

Subset the results into separate tables, containing all genes, differentially expressed genes in both directions, and directional tables.

```{r results-tables}
## Here we're creating subset tables of the DEGs, and adding the normalized
## counts used by DESeq2 for the differential expression analysis.
res_tbl_list <- mapply(
    FUN = resultsTables,
    object = res_list_shrunken,
    MoreArgs = list(
        DESeqDataSet = dds,
        alpha = params$alpha,
        lfcThreshold = params$lfc_threshold
    ),
    SIMPLIFY = FALSE,
    USE.NAMES = TRUE
)
assignAndSaveData(
    name = paste(name, "res_tbl_list", sep = "_"),
    object = res_tbl_list,
    dir = params$data_dir
)
```

```{r export-results-tables}
list <- res_tbl_list
for (a in seq_along(list)) {
    for (b in seq_along(list[[a]])) {
        subdir_name <- 
        file_name <- 
        file <- file.path(
            params$results_dir,
            names(list)[[a]],
            paste0(names(list[[a]])[[b]], ".csv.gz")
        )
        message(paste("Exporting", file))
        export(object = list[[a]][[b]], file = file)
    }
}
```

Differentially expressed gene (DEG) tables are sorted by BH-adjusted P value, and contain the following columns:

- `baseMean`: Mean of the normalized counts per gene for all samples.
- `log2FoldChange`: log2 fold change.
- `lfcSE`: log2 standard error.
- `stat`: Wald statistic.
- `pvalue`: Walt test *P* value.
- `padj`: BH adjusted Wald test *P* value (corrected for multiple comparisons; aka FDR).

```{r footer, child="_footer.Rmd"}
```

```{r links, child="_links.Rmd"}
```
