[med-svn] [r-bioc-deseq2] 01/05: Imported Upstream version 1.10.1
Michael Crusoe
misterc-guest at moszumanska.debian.org
Tue Jun 28 16:22:41 UTC 2016
This is an automated email from the git hooks/post-receive script.
misterc-guest pushed a commit to branch master
in repository r-bioc-deseq2.
commit 1851a4daf592334870481b408958c3cad89f9e59
Author: Michael R. Crusoe <crusoe at ucdavis.edu>
Date: Fri Jan 15 06:58:04 2016 -0800
Imported Upstream version 1.10.1
---
DESCRIPTION | 26 +
NAMESPACE | 86 +
NEWS | 458 +++++
R/AllClasses.R | 378 ++++
R/AllGenerics.R | 23 +
R/RcppExports.R | 15 +
R/core.R | 2770 +++++++++++++++++++++++++++++
R/expanded.R | 100 ++
R/helper.R | 535 ++++++
R/methods.R | 776 ++++++++
R/plots.R | 355 ++++
R/results.R | 1089 ++++++++++++
R/rlog.R | 291 +++
R/vst.R | 203 +++
build/vignette.rds | Bin 0 -> 228 bytes
inst/CITATION | 15 +
inst/doc/DESeq2.Rnw | 2161 ++++++++++++++++++++++
inst/doc/DESeq2.pdf | Bin 0 -> 642417 bytes
inst/script/deseq2.R | 322 ++++
inst/script/makeSim.R | 11 +
inst/script/runScripts.R | 171 ++
inst/script/simulateCluster.R | 66 +
inst/script/simulateDE.R | 67 +
inst/script/simulateLFCAccuracy.R | 67 +
inst/script/simulateOutliers.R | 91 +
inst/script/simulation.Rmd | 397 +++++
inst/script/simulation.pdf | Bin 0 -> 377985 bytes
inst/script/testsuite.Rmd | 173 ++
man/DESeq.Rd | 178 ++
man/DESeq2-package.Rd | 31 +
man/DESeqDataSet.Rd | 87 +
man/DESeqResults.Rd | 25 +
man/DESeqTransform.Rd | 26 +
man/coef.Rd | 42 +
man/collapseReplicates.Rd | 57 +
man/counts.Rd | 48 +
man/design.Rd | 31 +
man/dispersionFunction.Rd | 51 +
man/dispersions.Rd | 37 +
man/estimateBetaPriorVar.Rd | 44 +
man/estimateDispersions.Rd | 103 ++
man/estimateDispersionsGeneEst.Rd | 98 +
man/estimateSizeFactors.Rd | 96 +
man/estimateSizeFactorsForMatrix.Rd | 51 +
man/fpkm.Rd | 78 +
man/fpm.Rd | 61 +
man/makeExampleDESeqDataSet.Rd | 43 +
man/nbinomLRT.Rd | 73 +
man/nbinomWaldTest.Rd | 122 ++
man/normTransform.Rd | 23 +
man/normalizationFactors.Rd | 64 +
man/normalizeGeneLength.Rd | 107 ++
man/plotCounts.Rd | 44 +
man/plotDispEsts.Rd | 52 +
man/plotMA.Rd | 62 +
man/plotPCA.Rd | 60 +
man/plotSparsity.Rd | 30 +
man/replaceOutliers.Rd | 72 +
man/results.Rd | 309 ++++
man/rlog.Rd | 136 ++
man/show.Rd | 23 +
man/sizeFactors.Rd | 35 +
man/summary.Rd | 35 +
man/varianceStabilizingTransformation.Rd | 141 ++
src/DESeq2.cpp | 393 ++++
src/Makevars | 1 +
src/Makevars.win | 2 +
src/RcppExports.cpp | 66 +
tests/testthat.R | 3 +
tests/testthat/test_1vs1.R | 3 +
tests/testthat/test_DESeq.R | 17 +
tests/testthat/test_LRT.R | 8 +
tests/testthat/test_LRT_prior.R | 13 +
tests/testthat/test_QR.R | 8 +
tests/testthat/test_addMLE.R | 18 +
tests/testthat/test_betaFitting.R | 44 +
tests/testthat/test_collapse.R | 6 +
tests/testthat/test_construction_errors.R | 36 +
tests/testthat/test_counts_input.R | 14 +
tests/testthat/test_custom_filt.R | 25 +
tests/testthat/test_disp_fit.R | 113 ++
tests/testthat/test_dispersions.R | 28 +
tests/testthat/test_edge_case.R | 46 +
tests/testthat/test_factors.R | 9 +
tests/testthat/test_fpkm.R | 5 +
tests/testthat/test_frozen_transform.R | 27 +
tests/testthat/test_gene_length.R | 29 +
tests/testthat/test_htseq.R | 7 +
tests/testthat/test_interactions.R | 8 +
tests/testthat/test_methods.R | 8 +
tests/testthat/test_model_matrix.R | 18 +
tests/testthat/test_nbinomWald.R | 15 +
tests/testthat/test_optim.R | 34 +
tests/testthat/test_outlier.R | 65 +
tests/testthat/test_parallel.R | 64 +
tests/testthat/test_plots.R | 25 +
tests/testthat/test_results.R | 153 ++
tests/testthat/test_rlog.R | 24 +
tests/testthat/test_size_factor.R | 22 +
tests/testthat/test_vst.R | 18 +
tests/testthat/test_zero_zero.R | 18 +
vignettes/DESeq2.Rnw | 2161 ++++++++++++++++++++++
vignettes/library.bib | 243 +++
vignettes/vst.nb | 1000 +++++++++++
vignettes/vst.pdf | Bin 0 -> 186353 bytes
105 files changed, 18018 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..dd067d4
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,26 @@
+Package: DESeq2
+Type: Package
+Title: Differential gene expression analysis based on the negative
+ binomial distribution
+Version: 1.10.1
+Author: Michael Love (HSPH Boston), Simon Anders, Wolfgang Huber (EMBL
+ Heidelberg)
+Maintainer: Michael Love <michaelisaiahlove at gmail.com>
+Description: Estimate variance-mean dependence in count data from
+ high-throughput sequencing assays and test for differential
+ expression based on a model using the negative binomial
+ distribution.
+License: LGPL (>= 3)
+VignetteBuilder: knitr
+Imports: BiocGenerics (>= 0.7.5), Biobase, BiocParallel, genefilter,
+ methods, locfit, geneplotter, ggplot2, Hmisc
+Depends: S4Vectors, IRanges, GenomicRanges, SummarizedExperiment (>=
+ 0.2.0), Rcpp (>= 0.10.1), RcppArmadillo (>= 0.3.4.4)
+Suggests: testthat, knitr, BiocStyle, vsn, pheatmap, RColorBrewer,
+ airway, pasilla (>= 0.2.10), DESeq
+LinkingTo: Rcpp, RcppArmadillo
+biocViews: Sequencing, ChIPSeq, RNASeq, SAGE, DifferentialExpression,
+ GeneExpression
+RoxygenNote: 5.0.1
+NeedsCompilation: yes
+Packaged: 2015-12-21 03:33:03 UTC; biocbuild
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..1824d77
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,86 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(coef,DESeqDataSet)
+export("dispersionFunction<-")
+export("dispersions<-")
+export("normalizationFactors<-")
+export(DESeq)
+export(DESeqDataSet)
+export(DESeqDataSetFromHTSeqCount)
+export(DESeqDataSetFromMatrix)
+export(DESeqResults)
+export(DESeqTransform)
+export(collapseReplicates)
+export(dispersionFunction)
+export(dispersions)
+export(estimateBetaPriorVar)
+export(estimateDispersionsFit)
+export(estimateDispersionsGeneEst)
+export(estimateDispersionsMAP)
+export(estimateDispersionsPriorVar)
+export(estimateMLEForBetaPriorVar)
+export(estimateSizeFactorsForMatrix)
+export(fpkm)
+export(fpm)
+export(getVarianceStabilizedData)
+export(makeExampleDESeqDataSet)
+export(nbinomLRT)
+export(nbinomWaldTest)
+export(normTransform)
+export(normalizationFactors)
+export(normalizeGeneLength)
+export(plotCounts)
+export(plotSparsity)
+export(removeResults)
+export(replaceOutliers)
+export(replaceOutliersWithTrimmedMean)
+export(results)
+export(resultsNames)
+export(rlog)
+export(rlogTransformation)
+export(summary.DESeqResults)
+export(varianceStabilizingTransformation)
+exportClasses(DESeqDataSet)
+exportClasses(DESeqResults)
+exportClasses(DESeqTransform)
+exportMethods("counts<-")
+exportMethods("design<-")
+exportMethods("dispersionFunction<-")
+exportMethods("dispersions<-")
+exportMethods("normalizationFactors<-")
+exportMethods("sizeFactors<-")
+exportMethods(counts)
+exportMethods(design)
+exportMethods(dispersionFunction)
+exportMethods(dispersions)
+exportMethods(estimateDispersions)
+exportMethods(estimateSizeFactors)
+exportMethods(normalizationFactors)
+exportMethods(plotDispEsts)
+exportMethods(plotMA)
+exportMethods(plotPCA)
+exportMethods(show)
+exportMethods(sizeFactors)
+import(Biobase)
+import(BiocGenerics)
+import(BiocParallel)
+import(GenomicRanges)
+import(IRanges)
+import(Rcpp)
+import(RcppArmadillo)
+import(S4Vectors)
+import(SummarizedExperiment)
+import(methods)
+importFrom(Hmisc,wtd.quantile)
+importFrom(genefilter,filtered_p)
+importFrom(genefilter,rowVars)
+importFrom(geneplotter,plotMA)
+importFrom(ggplot2,aes_string)
+importFrom(ggplot2,coord_fixed)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,xlab)
+importFrom(ggplot2,ylab)
+importFrom(locfit,locfit)
+importFrom(stats,coef)
+useDynLib(DESeq2)
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..05c62b1
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,458 @@
+CHANGES IN VERSION 1.10.1
+-------------------------
+
+ o Change import of ggplot2 to selective import, to avoid collisions
+ with BiocGenerics.
+
+CHANGES IN VERSION 1.10.0
+-------------------------
+
+ o Added MLE argument to plotMA().
+
+ o Added normTransform() for simple log2(K/s + 1) transformation,
+ where K is a count and s is a size factor.
+
+ o When the design contains an interaction, DESeq() will use
+ betaPrior=FALSE. This makes coefficients easier to interpret.
+
+ o Independent filtering will be less greedy, using as a
+ threshold the lowest quantile of the filter such that the
+ number of rejections is within 1 SD from the maximum.
+ See ?results.
+
+ o summary() and plotMA() will use 'alpha' from results().
+
+CHANGES IN VERSION 1.9.42
+-------------------------
+
+ o New function 'normTranform', for making DESeqTransform objects
+ from normalized counts plus a pseudocount (default 1) then
+ applying a transformation (default log2).
+
+ o Added MLE argument to plotMA(), if results() was run with
+ addMLE=TRUE, this allows for comparison of shrunken and
+ unshrunken estimates of fold change.
+
+ o summary() and plotMA() use the 'alpha' which was specified
+ in results() rather than defaulting to 0.1.
+
+ o Removed rlog's fast option, and instead recommending VST for
+ very large matrices of counts (100s of samples).
+
+CHANGES IN VERSION 1.9.17
+-------------------------
+
+ o Independent filtering: results() no longer uses the maximum
+ of the number of rejections as calculated by the filter_p() function
+ from the genefilter package. Small numbers of rejections at a
+ high quantile of the filter threshold could result in
+ a high filter threshold. Instead, now the results() function
+ will use the lowest quantile of the filter for which the
+ number of rejections is close to the peak of a lowess curve fit
+ through the number of rejections over the filter quantiles.
+ 'Close to' is defined as within 1 residual standard deviations.
+
+CHANGES IN VERSION 1.9.16
+-------------------------
+
+ o When the design formula contains interaction terms, the DESeq()
+ function will by default not use a beta prior (betaPrior=FALSE).
+ The previous implementation of a log fold change prior for
+ interaction terms returned accurate inference, but was confusing
+ for users to interpret. New instructions on building results tables
+ for designs with interactions will be included in the software
+ vignette.
+
+CHANGES IN VERSION 1.8.0
+------------------------
+
+ o Added support for user-supplied model matrices to DESeq(),
+ estimateDispersions() and nbinomWaldTest(). This helps
+ when the model matrix needs to be edited by the user.
+
+CHANGES IN VERSION 1.7.45
+-------------------------
+
+ o Added a test in rlog for sparse data, mostly zero and some
+ very large counts, which will give a warning and suggestion
+ for alternate transformations.
+
+ o Added plotSparsity() which will help diagnose issues for using rlog:
+ data which do not resemble negative binomial due to many genes
+ with mostly zeros and a few very large counts.
+
+CHANGES IN VERSION 1.7.43
+-------------------------
+
+ o Added 'replaced' argument to counts() and plotCounts() such
+ that the assay in "replaceCounts" will be used if it exists.
+ Raised a minimum dispersion value used in Cook's calculation,
+ so that other counts in a group with an outlier won't get extreme
+ Cook's distances themselves.
+
+CHANGES IN VERSION 1.7.32
+-------------------------
+
+ o Added logic to results() which will zero out the LFC, Wald
+ statistic and set p-value to 1, for 'contrast' argument
+ results tables where the contrasted groups all have zero count.
+ Non-zero LFCs were otherwise occuring due to large differences
+ in the size factors.
+
+CHANGES IN VERSION 1.7.11
+-------------------------
+
+ o Added support for user-supplied model matrices to DESeq(),
+ estimateDispersions() and nbinomWaldTest().
+
+CHANGES IN VERSION 1.7.9
+------------------------
+
+ o Added Genome Biology citation for the DESeq2 methods.
+
+ o Introduced type="iterate" for estimateSizeFactors,
+ an alternative estimator for the size factors, which
+ can be used even when all genes have a sample with a
+ count of zero. See man page for details.
+
+CHANGES IN VERSION 1.7.3
+------------------------
+
+ o Fixed two minor bugs:
+ DESeq() with parallel=TRUE was dropping rows with all zero
+ counts, instead of propogating NAs.
+ nbinomLRT() with matrices provided to 'full' and 'reduced' and
+ a design of ~ 1, the matrices were being ignored.
+
+CHANGES IN VERSION 1.6.0
+------------------------
+
+ o DESeq() and results() gets a 'parallel' argument.
+
+ o results() gets an 'addMLE' argument.
+
+ o results() gets a 'test' argument, for constructing Wald tests
+ after DESeq() was run using the likelihood ratio test.
+
+ o results() argument 'format' for GRanges or GRangesList results.
+
+ o new plotCounts() function.
+
+ o Less outlier calling from Cook's distance for analyses with
+ many samples and many conditions.
+
+ o More robust beta prior variance and log fold change shrinkage.
+
+CHANGES IN VERSION 1.5.70
+-------------------------
+
+ o Added 'parallel' also for results(), which can be slow if run with
+ 100s of samples.
+
+CHANGES IN VERSION 1.5.54
+-------------------------
+
+ o Added 'parallel' argument to DESeq() which splits up the analysis
+ over genes for those steps which are easily done in parallel,
+ leveraging BiocParallel's bplapply.
+
+CHANGES IN VERSION 1.5.50
+-------------------------
+
+ o A matrix can be provided to rlog or to the VST and will return
+ a matrix. Also 'fitType' argument is included, in case dispersions
+ are not estimated which is passed on to estimateDispersions.
+
+CHANGES IN VERSION 1.5.49
+-------------------------
+
+ o The fast=TRUE implementation of rlog is even faster, subsetting
+ genes along the range of base mean to estimate the dispersion
+ trend and for fitting the optimal amount of shrinkage.
+
+CHANGES IN VERSION 1.5.40
+-------------------------
+
+ o Further improved code behind the robust estimation of variance
+ for Cook's cutoff, resulting in less outlier calls due to
+ an individual condition with few samples and high variance.
+
+CHANGES IN VERSION 1.5.28
+-------------------------
+
+ o New results() argument 'addMLE' adds the unshrunken fold changes
+ for simple contrasts or interaction terms to the results tables.
+
+CHANGES IN VERSION 1.5.27
+-------------------------
+
+ o Applied the beta prior variance calculation from v1.5.22 to the
+ regularized logarithm.
+
+ o Added MLE coefficients as MLE_condition_B_vs_A columns to mcols(dds).
+
+ o Fixed the statistic which is returned when lfcThreshold is used.
+ Previously, only the p-value and adjusted p-value was changed.
+
+ o plotPCA() with argument 'returnData' will return a data.frame
+ which can be used for custom plotting.
+
+CHANGES IN VERSION 1.5.25
+-------------------------
+
+ o Improved the robust variance estimate used for calculating
+ Cook's distances. The previous estimate could lead to outlier
+ calls in datasets with many conditions, and when a single
+ condition had large, highly variable counts for all its samples.
+
+CHANGES IN VERSION 1.5.22
+-------------------------
+
+ o Adding an alternate method for beta prior variance calculation
+ in nbinomWaldTest. This helps to produce more robust prior
+ variance estimates when many genes have small counts and highly
+ variable MLE log fold changes.
+
+CHANGES IN VERSION 1.5.15
+-------------------------
+
+ o For likelihood ratio test, expanded model matrices not default.
+ Some improvements in fit time from handling of genes with
+ dispersions that do not converge using line search.
+
+CHANGES IN VERSION 1.5.13
+-------------------------
+
+ o Adding test argument to results(), which allows users to perform
+ a Wald test after DESeq(dds, test="LRT") / nbinomLRT has been run.
+
+CHANGES IN VERSION 1.5.11
+------------------------
+
+ o Swapping in ggplot2 for lattice for the plotPCA function.
+
+CHANGES IN VERSION 1.5.9
+------------------------
+
+ o Added a VST for fitType = mean. Allowed designs with ~ 0
+ and betaPrior = FALSE. Fixed some potential metadata
+ column insertion bugs.
+
+CHANGES IN VERSION 1.5.8
+------------------------
+
+ o Suppress the glm.fit convergence warning from parametric dispersion
+ curve fitting procedure, instead use this for the iterative
+ convergence test.
+
+CHANGES IN VERSION 1.5.3
+------------------------
+
+ o Speeding up and reducing copying for DESeqDataSet construction.
+
+CHANGES IN VERSION 1.5.2
+------------------------
+
+ o Added 'format' argument to results, which will attach results to
+ GRangesList or GRanges if requested (default is DataFrame).
+
+CHANGES IN VERSION 1.4.4
+------------------------
+
+ o Fixed a hang which could occur in the GLM fitting procedure.
+
+CHANGES IN VERSION 1.4.3
+------------------------
+
+ o Fixed simple bug when using normalizationFactors and running
+ nbinomWaldTest, error was "no method for coercing this S4 class
+ to a vector".
+
+CHANGES IN VERSION 1.4.2
+------------------------
+
+ o Fixed bugs: estimating beta prior for interaction between factor
+ and numeric; not returning row names for counts(); construction
+ of DESeqDataSet gives wrong error when there are empty levels:
+ instead now drops the levels for the user.
+
+
+CHANGES IN VERSION 1.4.1
+------------------------
+
+ o Fixed bug where DESeqDataSetFromHTSeqCount() imported the special
+ rows, "_ambiguous", etc.
+
+CHANGES IN VERSION 1.4.0
+------------------------
+
+ o *** USAGE NOTE *** Expanded model matrices are now used when
+ betaPrior = TRUE (the default). Therefore, level comparison results
+ should be extracted using the 'contrast' argument to the results()
+ function. Expanded model matrices produce shrinkage of log
+ fold changes that is independent of the choice of base level.
+ Expanded model matrices are not used in the case of designs
+ with an interaction term between factors with only 2 levels.
+
+ o The order of the arguments 'name' and 'contrast' to the results()
+ function are swapped, to indicate that 'contrast' should be used
+ for the standard comparisons of levels against each other.
+ Calling results() with no arguments will still produce the
+ same comparison: the fold change of the last level of the last
+ design variable over the first level of the last design variable.
+ See ?results for more details.
+
+ o The DESeq() function will automatically replace count outliers
+ flagged by Cook's distance when there are 7 or more replicates.
+ The DESeq() argument 'minReplicatesForReplace' (default 7)
+ is used to decide which samples are eligible for automatic
+ replacement. This default behavior helps to prevent filtering
+ genes based on Cook's distance when there are many degrees of
+ freedom.
+
+CHANGES IN VERSION 1.3.58
+-------------------------
+
+ o Added a list() option to the 'contrast' argument of results().
+ See examples in ?results.
+
+CHANGES IN VERSION 1.3.24
+-------------------------
+
+ o rlogTransformation() gains an argument 'fast', which switches to
+ an approximation of the rlog transformation. Speed-up is ~ 2x.
+
+ o A more robust estimator for the beta prior variance is used:
+ instead of taking the mean of squared MLE betas, the prior variance
+ is found by matching an upper quantile of the absolute value of
+ MLE betas with an upper quantile of a zero-centered Normal
+ distribution.
+
+CHANGES IN VERSION 1.3.17
+-------------------------
+
+ o It is possible to use a log2 fold change prior (beta prior)
+ and obtain likelihood ratio test p-values, although the default
+ for test="LRT" is still betaPrior=FALSE.
+
+CHANGES IN VERSION 1.3.15
+-------------------------
+
+ o The DESeq() function will automatically replace count outliers
+ flagged by Cook's distance when there are 7 or more replicates.
+ The DESeq() argument 'minReplicatesForReplace' (default 7)
+ is used to decide which samples are eligible for automatic
+ replacement. This default behavior helps to prevent filtering
+ genes based on Cook's distance when there are many degrees of
+ freedom.
+
+ o The results() function produces an object of class 'DESeqResults'
+ which is a simple subclass of 'DataFrame'. This class allows for
+ methods to be written specifically for DESeq2 results. For example,
+ plotMA() can be called on a 'DESeqResults' object.
+
+CHANGES IN VERSION 1.3.12
+-------------------------
+
+ o Added a check in nbinomWaldTest which ensures that priors
+ on logarithmic fold changes are only estimated for interactions
+ terms, in the case that interaction terms are present in the
+ design formula.
+
+CHANGES IN VERSION 1.3.6
+------------------------
+
+ o Reduced the amount of filtering from Cook's cutoff:
+ maximum no longer includes samples from experimental groups
+ with only 2 samples, the default F quantile is raised to 0.99,
+ and a robust estimate of dispersion is used to calculate
+ Cook's distance instead of the fitted dispersion.
+
+CHANGES IN VERSION 1.3.5
+------------------------
+
+ o New arguments to results(), 'lfcThreshold' and
+ 'alternativeHypothesis', allow for tests of log fold changes
+ which are above or below a given threshold.
+
+ o plotMA() function now passes ellipses arguments to the
+ results() function.
+
+CHANGES IN VERSION 1.1.32
+-------------------------
+
+ o By default, use QR decomposition on the design matrix X.
+ This stabilizes the GLM fitting. Can be turned off with
+ the useQR argument of nbinomWaldTest() and nbinomLRT().
+
+ o Allow for "frozen" normalization of new samples using
+ previous estimated parameters for the functions:
+ estimateSizeFactors(), varianceStabilizingTransformation(),
+ and rlogTransformation(). See manual pages for details and
+ examples.
+
+CHANGES IN VERSION 1.1.31
+-------------------------
+
+ o The adjustment of p-values and use of Cook's distance
+ for outlier detection is moved to results() function
+ instead of nbinomWaldTest(), nbinomLRT(), or DESeq().
+ This allows the user to change parameter settings
+ without having to refit the model.
+
+CHANGES IN VERSION 1.1.24
+-------------------------
+
+ o The results() function allows the user to specify a
+ contrast of coefficients, either using the names of
+ the factor and levels, or using a numeric contrast
+ vector. Contrasts are only available for the Wald test
+ differential analysis.
+
+CHANGES IN VERSION 1.1.23
+-------------------------
+
+ o The results() function automatically performs independent
+ filtering using the genefilter package and optimizing
+ over the mean of normalized counts.
+
+CHANGES IN VERSION 1.1.21
+-------------------------
+
+ o The regularized log transformation uses the fitted
+ dispersions instead of the MAP dispersions. This prevents
+ large, true log fold changes from being moderated due to
+ a large dispersion estimate blind to the design formula.
+ This behavior is also more consistent with the variance
+ stabilizing transformation.
+
+CHANGES IN VERSION 1.0.10
+-------------------------
+
+ o Outlier detection: Cook's distances are calculated for each
+ sample per gene and the matrix is stored in the assays list.
+ These values are used to determine genes in which a single
+ sample disproportionately influences the fitted coefficients.
+ These genes are flagged and the p-values set to NA.
+ The argument 'cooksCutoff' of nbinomWaldTest() and
+ nbinomLRT() can be used to control this functionality.
+
+
+CHANGES IN VERSION 1.0.0
+------------------------
+
+ o Base class: SummarizedExperiment is used as the superclass
+ for storing the data.
+
+ o Workflow: The wrapper function DESeq() performs all steps
+ for a differential expression analysis. Individual steps are
+ still accessible.
+
+ o Statistics: Incorporation of prior distributions into the
+ estimation of dispersions and fold changes (empirical-Bayes
+ shrinkage). A Wald test for significance is provided as the
+ default inference method, with the likelihood ratio test of
+ the previous version also available.
+
+ o Normalization: it is possible to provide a matrix of sample-
+ *and* gene-specific normalization factors
diff --git a/R/AllClasses.R b/R/AllClasses.R
new file mode 100644
index 0000000..ad61ab8
--- /dev/null
+++ b/R/AllClasses.R
@@ -0,0 +1,378 @@
+#' @rdname DESeqDataSet
+#' @export
+setClass("DESeqDataSet",
+ contains = "RangedSummarizedExperiment",
+ representation = representation(
+ design = "formula",
+ dispersionFunction = "function"))
+
+setValidity( "DESeqDataSet", function( object ) {
+ if (! ("counts" %in% assayNames(object)) )
+ return( "the assays slot must contain a matrix named 'counts'" )
+ if ( !is.numeric( counts(object) ) )
+ return( "the count data is not numeric" )
+ if ( any( is.na( counts(object) ) ) )
+ return( "NA values are not allowed in the count matrix" )
+ if ( !is.integer( counts(object) ) )
+ return( "the count data is not in integer mode" )
+ if ( any( counts(object) < 0 ) )
+ return( "the count data contains negative values" )
+ design <- design(object)
+ designVars <- all.vars(design)
+ if (!all(designVars %in% names(colData(object)))) {
+ return("all variables in design formula must be columns in colData")
+ }
+ designVarsClass <- sapply(designVars, function(v) class(colData(object)[[v]]))
+ if (any(designVarsClass == "character")) {
+ return("
+
+variables in design formula are character vectors.
+ convert these columns of colData(object) to factors before including in the design formula")
+ }
+ designFactors <- designVars[designVarsClass == "factor"]
+ if (any(sapply(designFactors,function(v) any(duplicated(make.names(levels(colData(object)[[v]]))))))) {
+ return("
+
+factors in the design formula have non-unique level names after make.names() is applied.
+make.names() is used during the analysis to turn factor levels into safe column names.
+please only use letters and numbers for levels of factors in the design")
+ }
+ # else...
+ TRUE
+} )
+
+#' DESeqDataSet object and constructors
+#'
+#' \code{DESeqDataSet} is a subclass of \code{RangedSummarizedExperiment},
+#' used to store the input values, intermediate calculations and results of an
+#' analysis of differential expression. The \code{DESeqDataSet} class
+#' enforces non-negative integer values in the "counts" matrix stored as
+#' the first element in the assay list.
+#' In addition, a formula which specifies the design of the experiment must be provided.
+#' The constructor functions create a DESeqDataSet object
+#' from various types of input:
+#' a RangedSummarizedExperiment, a matrix, or count files generated by
+#' the python package HTSeq. See the vignette for examples of construction
+#' from all three input types.
+#'
+#' @param se a \code{RangedSummarizedExperiment} with columns of variables
+#' indicating sample information in \code{colData},
+#' and the counts as the first element in the assays list, which will
+#' be renamed "counts". A \code{RangedSummarizedExperiment} object can be
+#' generated by the function \code{summarizeOverlaps} in the GenomicAlignments
+#' package.
+#' @param design a \code{formula} which expresses how the counts for each gene
+#' depend on the variables in \code{colData}. Many R \code{formula} are valid,
+#' including designs with multiple variables, e.g., \code{~ group + condition},
+#' and designs with interactions, e.g., \code{~ genotype + treatment + genotype:treatment}.
+#' See \code{\link{results}} for a variety of designs and how to extract results tables.
+#' By default, the functions in this package will use
+#' the last variable in the formula for building results tables and plotting.
+#' \code{~ 1} can be used for no design, although users need to remember
+#' to switch to another design for differential testing.
+#' @param countData for matrix input: a matrix of non-negative integers
+#' @param colData for matrix input: a \code{DataFrame} or \code{data.frame} with at least a single column.
+#' Rows of colData correspond to columns of countData
+#' @param tidy for matrix input: whether the first column of countData is the rownames for the count matrix
+#' @param sampleTable for htseq-count: a \code{data.frame} with three or more columns. Each row
+#' describes one sample. The first column is the sample name, the second column
+#' the file name of the count file generated by htseq-count, and the remaining
+#' columns are sample metadata which will be stored in \code{colData}
+#' @param directory for htseq-count: the directory relative to which the filenames are specified. defaults to current directory
+#' @param ignoreRank use of this argument is reserved for DEXSeq developers only.
+#' Users will immediately encounter an error upon trying to estimate dispersion
+#' using a design with a model matrix which is not full rank.
+#' @param ... arguments provided to \code{SummarizedExperiment} including rowRanges and metadata. Note that
+#' for Bioconductor 3.1, rowRanges must be a GRanges or GRangesList, with potential metadata columns
+#' as a DataFrame accessed and stored with \code{mcols}. If a user wants to store metadata columns
+#' about the rows of the countData, but does not have GRanges or GRangesList information,
+#' first construct the DESeqDataSet without rowRanges and then add the DataFrame with \code{mcols(dds)}.
+#'
+#' @return A DESeqDataSet object.
+#'
+#' @aliases DESeqDataSet DESeqDataSet-class DESeqDataSetFromMatrix DESeqDataSetFromHTSeqCount
+#'
+#' @references See \url{http://www-huber.embl.de/users/anders/HTSeq} for htseq-count
+#'
+#' @docType class
+#'
+#' @examples
+#'
+#' countData <- matrix(1:100,ncol=4)
+#' condition <- factor(c("A","A","B","B"))
+#' dds <- DESeqDataSetFromMatrix(countData, DataFrame(condition), ~ condition)
+#'
+#' @rdname DESeqDataSet
+#' @export
+DESeqDataSet <- function(se, design, ignoreRank=FALSE) {
+ if (!is(se, "RangedSummarizedExperiment")) {
+ if (is(se, "SummarizedExperiment0")) {
+ se <- as(se, "RangedSummarizedExperiment")
+ } else if (is(se, "SummarizedExperiment")) {
+ # only to help transition from SummarizedExperiment to new
+ # RangedSummarizedExperiment objects, remove once transition is complete
+ se <- as(se, "RangedSummarizedExperiment")
+ } else {
+ stop("'se' must be a RangedSummarizedExperiment object")
+ }
+ }
+ if (is.null(assayNames(se)) || assayNames(se)[1] != "counts") {
+ message("renaming the first element in assays to 'counts'")
+ assayNames(se)[1] <- "counts"
+ }
+ # before validity check, try to convert assay to integer mode
+ if (any(is.na(assay(se))))
+ stop("NA values are not allowed in the count matrix")
+ if (any(assay(se) < 0)) {
+ stop("some values in assay are negative")
+ }
+ if (!is.integer(assay(se))) {
+ if (any(round(assay(se)) != assay(se))) {
+ stop("some values in assay are not integers")
+ }
+ message("converting counts to integer mode")
+ mode(assay(se)) <- "integer"
+ }
+
+ if (all(assay(se) == 0)) {
+ stop("all samples have 0 counts for all genes. check the counting script.")
+ }
+
+ if (all(rowSums(assay(se) == assay(se)[,1]) == ncol(se))) {
+ warning("all genes have equal values for all samples. will not be able to perform differential analysis")
+ }
+
+ if (any(duplicated(rownames(se)))) {
+ warning(sum(duplicated(rownames(se)))," duplicate rownames were renamed by adding numbers")
+ rnms <- rownames(se)
+ dups <- unique(rnms[duplicated(rnms)])
+ for (rn in dups) {
+ idx <- which(rnms == rn)
+ rnms[idx[-1]] <- paste(rnms[idx[-1]], c(seq_len(length(idx) - 1)), sep=".")
+ }
+ rownames(se) <- rnms
+ }
+
+ designVars <- all.vars(design)
+ if (!all(designVars %in% names(colData(se)))) {
+ stop("all variables in design formula must be columns in colData")
+ }
+
+ designVarsClass <- sapply(designVars, function(v) class(colData(se)[[v]]))
+ if (any(designVarsClass == "character")) {
+ warning("some variables in design formula are characters, converting to factors")
+ for (v in designVars[designVarsClass == "character"]) {
+ colData(se)[[v]] <- factor(colData(se)[[v]])
+ }
+ }
+
+ if (length(designVars) == 1) {
+ var <- colData(se)[[designVars]]
+ if (all(var == var[1])) {
+ stop("design has a single variable, with all samples having the same value.
+ use instead a design of '~ 1'. estimateSizeFactors, rlog and the VST can then be used")
+ }
+ }
+
+ designVarsNumeric <- sapply(designVars, function(v) is.numeric(colData(se)[[v]]))
+ if (any(designVarsNumeric)) {
+ warnIntVars <- FALSE
+ for (v in designVars[designVarsNumeric]) {
+ if (all(colData(se)[[v]] == round(colData(se)[[v]]))) {
+ warnIntVars <- TRUE
+ }
+ }
+ if (warnIntVars) {
+ message(paste0("the design formula contains a numeric variable with integer values,
+ specifying a model with increasing fold change for higher values.
+ did you mean for this to be a factor? if so, first convert
+ this variable to a factor using the factor() function"))
+ }
+ }
+
+ designFactors <- designVars[designVarsClass == "factor"]
+ missingLevels <- sapply(designFactors,function(v) any(table(colData(se)[[v]]) == 0))
+ if (any(missingLevels)) {
+ message("factor levels were dropped which had no samples")
+ for (v in designFactors[missingLevels]) {
+ colData(se)[[v]] <- droplevels(colData(se)[[v]])
+ }
+ }
+
+ modelMatrix <- model.matrix(design, data=as.data.frame(colData(se)))
+ if (!ignoreRank) {
+ checkFullRank(modelMatrix)
+ }
+
+ # if the last variable in the design formula is a
+ # factor, and has a level 'control', check if it is
+ # the reference level and if not print a message
+ lastDV <- length(designVars)
+ if (length(designVars) > 0 && designVarsClass[lastDV] == "factor") {
+ lastDVLvls <- levels(colData(se)[[designVars[lastDV]]])
+ controlSynonyms <- c("control","Control","CONTROL")
+ for (cSyn in controlSynonyms) {
+ if (cSyn %in% lastDVLvls) {
+ if (cSyn != lastDVLvls[1]) {
+ message(paste0("it appears that the last variable in the design formula, '",designVars[lastDV],"',
+ has a factor level, '",cSyn,"', which is not the reference level. we recommend
+ to use factor(...,levels=...) or relevel() to set this as the reference level
+ before proceeding. for more information, please see the 'Note on factor levels'
+ in vignette('DESeq2')."))
+ }
+ }
+ }
+ }
+
+ # Add columns on the columns
+ mcolsCols <- DataFrame(type=rep("input",ncol(colData(se))),
+ description=rep("",ncol(colData(se))))
+ mcols(colData(se)) <- if (is.null(mcols(colData(se)))) {
+ mcolsCols
+ } else if (all(names(mcols(colData(se))) == c("type","description"))) {
+ mcolsCols
+ } else {
+ cbind(mcols(colData(se)), mcolsCols)
+ }
+
+ dds <- new("DESeqDataSet", se, design = design)
+
+ # now we know we have at least an empty GRanges or GRangesList for rowRanges
+ # so we can create a metadata column 'type' for the mcols
+ # and we label any incoming columns as 'input'
+
+ # this is metadata columns on the rows
+ mcolsRows <- DataFrame(type=rep("input",ncol(mcols(dds))),
+ description=rep("",ncol(mcols(dds))))
+ mcols(mcols(dds)) <- if (is.null(mcols(mcols(dds)))) {
+ mcolsRows
+ } else if (all(names(mcols(mcols(dds))) == c("type","description"))) {
+ mcolsRows
+ } else {
+ cbind(mcols(mcols(dds)), mcolsRows)
+ }
+
+ return(dds)
+}
+
+#' @rdname DESeqDataSet
+#' @export
+DESeqDataSetFromMatrix <- function( countData, colData, design, tidy=FALSE, ignoreRank=FALSE, ... )
+{
+
+ if (tidy) {
+ stopifnot(ncol(countData) > 1)
+ rownms <- as.character(countData[,1])
+ countData <- countData[,-1,drop=FALSE]
+ rownames(countData) <- rownms
+ }
+
+ # we expect a matrix of counts, which are non-negative integers
+ countData <- as.matrix( countData )
+
+ if (is(colData,"data.frame")) colData <- DataFrame(colData, row.names=rownames(colData))
+
+ # check if the rownames of colData are simply in different order
+ # than the colnames of the countData, if so throw an error
+ # as the user probably should investigate what's wrong
+ if (!is.null(rownames(colData)) & !is.null(colnames(countData))) {
+ if (all(sort(rownames(colData)) == sort(colnames(countData)))) {
+ if (!all(rownames(colData) == colnames(countData))) {
+ stop(paste("rownames of the colData:
+ ",paste(rownames(colData),collapse=","),"
+ are not in the same order as the colnames of the countData:
+ ",paste(colnames(countData),collapse=",")))
+ }
+ }
+ }
+ if (is.null(rownames(colData)) & !is.null(colnames(countData))) {
+ rownames(colData) <- colnames(countData)
+ }
+
+ se <- SummarizedExperiment(assays = SimpleList(counts=countData), colData = colData, ...)
+ dds <- DESeqDataSet(se, design = design, ignoreRank)
+
+ return(dds)
+}
+
+#' @rdname DESeqDataSet
+#' @export
+DESeqDataSetFromHTSeqCount <- function( sampleTable, directory=".", design, ignoreRank=FALSE, ...)
+{
+ if (missing(design)) stop("design is missing")
+ l <- lapply( as.character( sampleTable[,2] ), function(fn) read.table( file.path( directory, fn ) ) )
+ if( ! all( sapply( l, function(a) all( a$V1 == l[[1]]$V1 ) ) ) )
+ stop( "Gene IDs (first column) differ between files." )
+ tbl <- sapply( l, function(a) a$V2 )
+ colnames(tbl) <- sampleTable[,1]
+ rownames(tbl) <- l[[1]]$V1
+ rownames(sampleTable) <- sampleTable[,1]
+ oldSpecialNames <- c("no_feature","ambiguous","too_low_aQual","not_aligned","alignment_not_unique")
+ # either starts with two underscores
+ # or is one of the old special names (htseq-count backward compatability)
+ specialRows <- (substr(rownames(tbl),1,1) == "_") | rownames(tbl) %in% oldSpecialNames
+ tbl <- tbl[ !specialRows, , drop=FALSE ]
+ dds <- DESeqDataSetFromMatrix(countData=tbl,colData=sampleTable[,-(1:2),drop=FALSE],design=design,ignoreRank, ...)
+ return(dds)
+}
+
+#' @rdname DESeqResults
+#' @export
+setClass("DESeqResults", contains="DataFrame")
+
+#' DESeqResults object and constructor
+#'
+#' This constructor function would not typically be used by "end users".
+#' This simple class extends the DataFrame class of the IRanges package
+#' to allow other packages to write methods for results
+#' objects from the DESeq2 package. It is used by \code{\link{results}}
+#' to wrap up the results table.
+#'
+#' @param DataFrame a DataFrame of results, standard column names are:
+#' baseMean, log2FoldChange, lfcSE, stat, pvalue, padj.
+#'
+#' @return a DESeqResults object
+#' @docType class
+#' @aliases DESeqResults-class
+#' @rdname DESeqResults
+#' @export
+DESeqResults <- function(DataFrame) {
+ new("DESeqResults", DataFrame)
+}
+
+#' @rdname DESeqTransform
+#' @export
+setClass("DESeqTransform", contains="RangedSummarizedExperiment")
+
+#' DESeqTransform object and constructor
+#'
+#' This constructor function would not typically be used by "end users".
+#' This simple class extends the RangedSummarizedExperiment class of the
+#' SummarizedExperiment package.
+#' It is used by \code{\link{rlog}} and
+#' \code{\link{varianceStabilizingTransformation}}
+#' to wrap up the results into a class for downstream methods,
+#' such as \code{\link{plotPCA}}.
+#'
+#' @param SummarizedExperiment a RangedSummarizedExperiment
+#'
+#' @return a DESeqTransform object
+#' @docType class
+#' @aliases DESeqTransform-class
+#' @rdname DESeqTransform
+#' @export
+DESeqTransform <- function(SummarizedExperiment) {
+ se <- SummarizedExperiment
+ if (!is(se, "RangedSummarizedExperiment")) {
+ if (is(se, "SummarizedExperiment0")) {
+ se <- as(se, "RangedSummarizedExperiment")
+ } else if (is(se, "SummarizedExperiment")) {
+ # only to help transition from SummarizedExperiment to new
+ # RangedSummarizedExperiment objects, remove once transition is complete
+ se <- as(se, "RangedSummarizedExperiment")
+ } else {
+ stop("'SummarizedExperiment' must be a RangedSummarizedExperiment object")
+ }
+ }
+ new("DESeqTransform", se)
+}
diff --git a/R/AllGenerics.R b/R/AllGenerics.R
new file mode 100644
index 0000000..0309ac1
--- /dev/null
+++ b/R/AllGenerics.R
@@ -0,0 +1,23 @@
+#' @rdname dispersionFunction
+#' @export
+setGeneric("dispersionFunction", function(object,...) standardGeneric("dispersionFunction"))
+
+#' @rdname dispersionFunction
+#' @export
+setGeneric("dispersionFunction<-", function(object,...,value) standardGeneric("dispersionFunction<-"))
+
+#' @rdname dispersions
+#' @export
+setGeneric("dispersions", function(object,...) standardGeneric("dispersions"))
+
+#' @rdname dispersions
+#' @export
+setGeneric("dispersions<-", function(object,...,value) standardGeneric("dispersions<-"))
+
+#' @rdname normalizationFactors
+#' @export
+setGeneric("normalizationFactors", function(object,...) standardGeneric("normalizationFactors"))
+
+#' @rdname normalizationFactors
+#' @export
+setGeneric("normalizationFactors<-", function(object,...,value) standardGeneric("normalizationFactors<-"))
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..108ec3a
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,15 @@
+# This file was generated by Rcpp::compileAttributes
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+fitDisp <- function(ySEXP, xSEXP, mu_hatSEXP, log_alphaSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, min_log_alphaSEXP, kappa_0SEXP, tolSEXP, maxitSEXP, use_priorSEXP) {
+ .Call('DESeq2_fitDisp', PACKAGE = 'DESeq2', ySEXP, xSEXP, mu_hatSEXP, log_alphaSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, min_log_alphaSEXP, kappa_0SEXP, tolSEXP, maxitSEXP, use_priorSEXP)
+}
+
+fitBeta <- function(ySEXP, xSEXP, nfSEXP, alpha_hatSEXP, contrastSEXP, beta_matSEXP, lambdaSEXP, tolSEXP, maxitSEXP, useQRSEXP) {
+ .Call('DESeq2_fitBeta', PACKAGE = 'DESeq2', ySEXP, xSEXP, nfSEXP, alpha_hatSEXP, contrastSEXP, beta_matSEXP, lambdaSEXP, tolSEXP, maxitSEXP, useQRSEXP)
+}
+
+fitDispGrid <- function(ySEXP, xSEXP, mu_hatSEXP, disp_gridSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, use_priorSEXP) {
+ .Call('DESeq2_fitDispGrid', PACKAGE = 'DESeq2', ySEXP, xSEXP, mu_hatSEXP, disp_gridSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, use_priorSEXP)
+}
+
diff --git a/R/core.R b/R/core.R
new file mode 100644
index 0000000..c4c9283
--- /dev/null
+++ b/R/core.R
@@ -0,0 +1,2770 @@
+############################################################
+#
+# DESeq2 organization of R files
+#
+# core.R ......... most of the statistical code (example call below)
+# methods.R ...... the S4 methods (estimateSizeFactors, etc.)
+# AllClasses.R ... class definitions and object constructors
+# AllGenerics.R .. the generics defined in DESeq2
+# results.R ...... results() function and helpers
+# plots.R ........ all plotting functions
+# helper.R ....... collapseReplicates, fpkm, fpm, DESeqParallel
+# expanded.R ..... helpers for dealing with expanded model matrices
+# RcppExports.R .. the R wrappers for the C++ functions
+# rlogTransformation.R
+# varianceStabilizingTransformation.R
+#
+# general outline of the internal function calls.
+# note: not all of these functions are exported.
+#
+# DESeq
+# |- estimateSizeFactors
+# |- estimateSizeFactorsForMatrix
+# |- estimateDispersions
+# |- estimateDispersionsGeneEst
+# |- fitNbinomGLMs
+# |- fitBeta (C++)
+# |- fitDisp (C++)
+# |- estimateDispersionsFit
+# |- estimateDispersionsMAP
+# |- estimateDispersionPriorVar
+# |- fitDisp (C++)
+# |- nbinomWaldTest
+# |- fitGLMsWithPrior
+# |- fitNbinomGLMs
+# |- fitBeta (C++)
+# |- estimateBetaPriorVar
+# |- fitNbinomGLMs
+# |- fitBeta (C++)
+#
+############################################################
+
+#' DESeq2 package for differential analysis of count data
+#'
+#' The main functions for differential analysis are \code{\link{DESeq}} and
+#' \code{\link{results}}. See the examples at \code{\link{DESeq}} for basic analysis steps.
+#' Two transformations offered for count data are
+#' the "regularized logarithm", \code{\link{rlog}},
+#' and \code{\link{varianceStabilizingTransformation}}.
+#' For more detailed information on usage, see the package vignette, by typing
+#' \code{vignette("DESeq2")}, or the workflow linked to on the first page
+#' of the vignette. All support questions should be posted to the Bioconductor
+#' support site: \url{support.bioconductor.org}.
+#'
+#' @references
+#'
+#' DESeq2 reference:
+#'
+#' Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+#'
+#' DESeq reference:
+#'
+#' Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+#'
+#' @author Michael Love, Wolfgang Huber, Simon Anders
+#'
+#' @docType package
+#' @name DESeq2-package
+#' @aliases DESeq2-package
+#' @keywords package
+NULL
+
+#' Differential expression analysis based on the Negative Binomial (a.k.a. Gamma-Poisson) distribution
+#'
+#' This function performs a default analysis through the steps:
+#' \enumerate{
+#' \item estimation of size factors: \code{\link{estimateSizeFactors}}
+#' \item estimation of dispersion: \code{\link{estimateDispersions}}
+#' \item Negative Binomial GLM fitting and Wald statistics: \code{\link{nbinomWaldTest}}
+#' }
+#' For complete details on each step, see the manual pages of the respective
+#' functions. After the \code{DESeq} function returns a DESeqDataSet object,
+#' results tables (log2 fold changes and p-values) can be generated
+#' using the \code{\link{results}} function. See the manual page
+#' for \code{\link{results}} for information on independent filtering and
+#' p-value adjustment for multiple test correction.
+#'
+#' The differential expression analysis uses a generalized linear model of the form:
+#'
+#' \deqn{ K_{ij} \sim \textrm{NB}( \mu_{ij}, \alpha_i) }{ K_ij ~ NB(mu_ij, alpha_i) }
+#' \deqn{ \mu_{ij} = s_j q_{ij} }{ mu_ij = s_j q_ij }
+#' \deqn{ \log_2(q_{ij}) = x_{j.} \beta_i }{ log2(q_ij) = x_j. beta_i }
+#'
+#' where counts \eqn{K_{ij}}{K_ij} for gene i, sample j are modeled using
+#' a Negative Binomial distribution with fitted mean \eqn{\mu_{ij}}{mu_ij}
+#' and a gene-specific dispersion parameter \eqn{\alpha_i}{alpha_i}.
+#' The fitted mean is composed of a sample-specific size factor
+#' \eqn{s_j}{s_j} and a parameter \eqn{q_{ij}}{q_ij} proportional to the
+#' expected true concentration of fragments for sample j.
+#' The coefficients \eqn{\beta_i}{beta_i} give the log2 fold changes for gene i for each
+#' column of the model matrix \eqn{X}{X}.
+#' The sample-specific size factors can be replaced by
+#' gene-specific normalization factors for each sample using
+#' \code{\link{normalizationFactors}}.
+#'
+#' For details on the fitting of the log2 fold changes and calculation of p-values,
+#' see \code{\link{nbinomWaldTest}} if using \code{test="Wald"},
+#' or \code{\link{nbinomLRT}} if using \code{test="LRT"}.
+#'
+#' Experiments without replicates do not allow for estimation of the dispersion
+#' of counts around the expected value for each group, which is critical for
+#' differential expression analysis. If an experimental design is
+#' supplied which does not contain the necessary degrees of freedom for differential
+#' analysis, \code{DESeq} will provide a message to the user and follow
+#' the strategy outlined in Anders and Huber (2010)
+#' under the section 'Working without replicates', wherein all the samples
+#' are considered as replicates of a single group for the estimation of dispersion.
+#' As noted in the reference above: "Some overestimation of the variance
+#' may be expected, which will make that approach conservative."
+#' Furthermore, "while one may not want to draw strong conclusions from such an analysis,
+#' it may still be useful for exploration and hypothesis generation."
+#'
+#' The argument \code{minReplicatesForReplace} is used to decide which samples
+#' are eligible for automatic replacement in the case of extreme Cook's distance.
+#' By default, \code{DESeq} will replace outliers if the Cook's distance is
+#' large for a sample which has 7 or more replicates (including itself).
+#' This replacement is performed by the \code{\link{replaceOutliers}}
+#' function. This default behavior helps to prevent filtering genes
+#' based on Cook's distance when there are many degrees of freedom.
+#' See \code{\link{results}} for more information about filtering using
+#' Cook's distance, and the 'Dealing with outliers' section of the vignette.
+#' Unlike the behavior of \code{\link{replaceOutliers}}, here original counts are
+#' kept in the matrix returned by \code{\link{counts}}, original Cook's
+#' distances are kept in \code{assays(dds)[["cooks"]]}, and the replacement
+#' counts used for fitting are kept in \code{assays(object)[["replaceCounts"]]}.
+#'
+#' Note that if a log2 fold change prior is used (betaPrior=TRUE)
+#' then expanded model matrices will be used in fitting. These are
+#' described in \code{\link{nbinomWaldTest}} and in the vignette. The
+#' \code{contrast} argument of \code{\link{results}} should be used for
+#' generating results tables.
+#'
+#' @return a \code{\link{DESeqDataSet}} object with results stored as
+#' metadata columns. These results should accessed by calling the \code{\link{results}}
+#' function. By default this will return the log2 fold changes and p-values for the last
+#' variable in the design formula. See \code{\link{results}} for how to access results
+#' for other variables.
+#'
+#' @param object a DESeqDataSet object, see the constructor functions
+#' \code{\link{DESeqDataSet}},
+#' \code{\link{DESeqDataSetFromMatrix}},
+#' \code{\link{DESeqDataSetFromHTSeqCount}}.
+#' @param test either "Wald" or "LRT", which will then use either
+#' Wald significance tests (defined by \code{\link{nbinomWaldTest}}),
+#' or the likelihood ratio test on the difference in deviance between a
+#' full and reduced model formula (defined by \code{\link{nbinomLRT}})
+#' @param fitType either "parametric", "local", or "mean"
+#' for the type of fitting of dispersions to the mean intensity.
+#' See \code{\link{estimateDispersions}} for description.
+#' @param betaPrior whether or not to put a zero-mean normal prior on
+#' the non-intercept coefficients
+#' See \code{\link{nbinomWaldTest}} for description of the calculation
+#' of the beta prior. By default, the beta prior is used only for the
+#' Wald test, but can also be specified for the likelihood ratio test.
+#' @param full for \code{test="LRT"}, the full model formula,
+#' which is restricted to the formula in \code{design(object)}.
+#' alternatively, it can be a model matrix constructed by the user.
+#' advanced use: specifying a model matrix for full and \code{test="Wald"}
+#' is possible if \code{betaPrior=FALSE}
+#' @param reduced for \code{test="LRT"}, a reduced formula to compare against,
+#' i.e., the full formula with the term(s) of interest removed.
+#' alternatively, it can be a model matrix constructed by the user
+#' @param quiet whether to print messages at each step
+#' @param minReplicatesForReplace the minimum number of replicates required
+#' in order to use \code{\link{replaceOutliers}} on a
+#' sample. If there are samples with so many replicates, the model will
+#' be refit after these replacing outliers, flagged by Cook's distance.
+#' Set to \code{Inf} in order to never replace outliers.
+#' @param modelMatrixType either "standard" or "expanded", which describe
+#' how the model matrix, X of the GLM formula is formed.
+#' "standard" is as created by \code{model.matrix} using the
+#' design formula. "expanded" includes an indicator variable for each
+#' level of factors in addition to an intercept. for more information
+#' see the Description of \code{\link{nbinomWaldTest}}.
+#' betaPrior must be set to TRUE in order for expanded model matrices
+#' to be fit.
+#' @param parallel if FALSE, no parallelization. if TRUE, parallel
+#' execution using \code{BiocParallel}, see next argument \code{BPPARAM}.
+#' A note on running in parallel using \code{BiocParallel}: it may be
+#' advantageous to remove large, unneeded objects from your current
+#' R environment before calling \code{DESeq},
+#' as it is possible that R's internal garbage collection
+#' will copy these files while running on worker nodes.
+#' @param BPPARAM an optional parameter object passed internally
+#' to \code{\link{bplapply}} when \code{parallel=TRUE}.
+#' If not specified, the parameters last registered with
+#' \code{\link{register}} will be used.
+#'
+#' @author Michael Love
+#'
+#' @references
+#'
+#' Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+#' @import BiocGenerics BiocParallel S4Vectors IRanges GenomicRanges SummarizedExperiment Biobase Rcpp RcppArmadillo methods
+#'
+#' @importFrom locfit locfit
+#' @importFrom genefilter rowVars filtered_p
+#' @importFrom Hmisc wtd.quantile
+#'
+#' @useDynLib DESeq2
+#'
+#' @seealso \code{\link{nbinomWaldTest}}, \code{\link{nbinomLRT}}
+#'
+#' @examples
+#'
+#' # see vignette for suggestions on generating
+#' # count tables from RNA-Seq data
+#' cnts <- matrix(rnbinom(n=1000, mu=100, size=1/0.5), ncol=10)
+#' cond <- factor(rep(1:2, each=5))
+#'
+#' # object construction
+#' dds <- DESeqDataSetFromMatrix(cnts, DataFrame(cond), ~ cond)
+#'
+#' # standard analysis
+#' dds <- DESeq(dds)
+#' res <- results(dds)
+#'
+#' # an alternate analysis: likelihood ratio test
+#' ddsLRT <- DESeq(dds, test="LRT", reduced= ~ 1)
+#' resLRT <- results(ddsLRT)
+#'
+#' @export
+DESeq <- function(object, test=c("Wald","LRT"),
+ fitType=c("parametric","local","mean"), betaPrior,
+ full=design(object), reduced, quiet=FALSE,
+ minReplicatesForReplace=7, modelMatrixType,
+ parallel=FALSE, BPPARAM=bpparam()) {
+ # check arguments
+ stopifnot(is(object, "DESeqDataSet"))
+ test <- match.arg(test, choices=c("Wald","LRT"))
+ fitType <- match.arg(fitType, choices=c("parametric","local","mean"))
+ stopifnot(is.logical(quiet))
+ stopifnot(is.numeric(minReplicatesForReplace))
+ stopifnot(is.logical(parallel))
+ modelAsFormula <- !is.matrix(full)
+
+ if (missing(betaPrior)) {
+ betaPrior <- if (modelAsFormula) {
+ termsOrder <- attr(terms.formula(design(object)),"order")
+ interactionPresent <- any(termsOrder > 1)
+ # use beta prior for Wald tests and when no interaction terms are included
+ (test == "Wald") & !interactionPresent
+ } else {
+ FALSE
+ }
+ } else {
+ stopifnot(is.logical(betaPrior))
+ }
+ # get rid of any NA in the mcols(mcols(object))
+ object <- sanitizeRowRanges(object)
+
+ if (test == "LRT") {
+ if (missing(reduced)) {
+ stop("likelihood ratio test requires a 'reduced' design, see ?DESeq")
+ }
+ if (!missing(modelMatrixType) && modelMatrixType == "expanded") {
+ stop("test='LRT' only implemented for standard model matrices")
+ }
+ if (is.matrix(full) | is.matrix(reduced)) {
+ if (!(is.matrix(full) & is.matrix(reduced))) {
+ stop("if one of 'full' and 'reduced' is a matrix, the other must be also a matrix")
+ }
+ }
+ if (modelAsFormula) {
+ checkLRT(full, reduced)
+ } else {
+ if (ncol(full) <= ncol(reduced)) {
+ stop("the number of columns of 'full' should be more than the number of columns of 'reduced'")
+ }
+ }
+ }
+ if (test == "Wald" & !missing(reduced)) {
+ stop("'reduced' ignored when test='Wald'")
+ }
+
+ if (modelAsFormula) {
+
+ # run some tests common to DESeq, nbinomWaldTest, nbinomLRT
+ designAndArgChecker(object, betaPrior)
+
+ if (full != design(object)) {
+ stop("'full' specified as formula should equal design(object)")
+ }
+ modelMatrix <- NULL
+ } else {
+ if (betaPrior == TRUE) {
+ stop("betaPrior=TRUE is not supported for user-provided model matrices")
+ }
+ # this will be used for dispersion estimation and testing
+ modelMatrix <- full
+ }
+
+ attr(object, "betaPrior") <- betaPrior
+ stopifnot(length(parallel) == 1 & is.logical(parallel))
+
+ if (!is.null(sizeFactors(object)) || !is.null(normalizationFactors(object))) {
+ if (!quiet) {
+ if (!is.null(normalizationFactors(object))) {
+ message("using pre-existing normalization factors")
+ } else {
+ message("using pre-existing size factors")
+ }
+ }
+ } else {
+ if (!quiet) message("estimating size factors")
+ object <- estimateSizeFactors(object)
+ }
+
+ if (!parallel) {
+ if (!quiet) message("estimating dispersions")
+ object <- estimateDispersions(object, fitType=fitType, quiet=quiet, modelMatrix=modelMatrix)
+ if (!quiet) message("fitting model and testing")
+ if (test == "Wald") {
+ object <- nbinomWaldTest(object, betaPrior=betaPrior, quiet=quiet,
+ modelMatrix=modelMatrix,
+ modelMatrixType=modelMatrixType)
+ } else if (test == "LRT") {
+ object <- nbinomLRT(object, full=full, reduced=reduced,
+ betaPrior=betaPrior, quiet=quiet)
+ }
+ } else if (parallel) {
+ object <- DESeqParallel(object, test=test, fitType=fitType,
+ betaPrior=betaPrior, full=full, reduced=reduced,
+ quiet=quiet, modelMatrix=modelMatrix,
+ modelMatrixType=modelMatrixType,
+ BPPARAM=BPPARAM)
+ }
+
+ # if there are sufficient replicates, then pass through to refitting function
+ sufficientReps <- any(nOrMoreInCell(attr(object,"modelMatrix"),minReplicatesForReplace))
+ if (sufficientReps) {
+ object <- refitWithoutOutliers(object, test=test, betaPrior=betaPrior,
+ full=full, reduced=reduced, quiet=quiet,
+ minReplicatesForReplace=minReplicatesForReplace,
+ modelMatrix=modelMatrix,
+ modelMatrixType=modelMatrixType)
+ }
+
+ object
+}
+
+#' Make a simulated DESeqDataSet
+#'
+#' Constructs a simulated dataset of Negative Binomial data from
+#' two conditions. By default, there are no fold changes between
+#' the two conditions, but this can be adjusted with the \code{betaSD} argument.
+#'
+#' @param n number of rows
+#' @param m number of columns
+#' @param betaSD the standard deviation for non-intercept betas, i.e. beta ~ N(0,betaSD)
+#' @param interceptMean the mean of the intercept betas (log2 scale)
+#' @param interceptSD the standard deviation of the intercept betas (log2 scale)
+#' @param dispMeanRel a function specifying the relationship of the dispersions on
+#' \code{2^trueIntercept}
+#' @param sizeFactors multiplicative factors for each sample
+#'
+#' @return a \code{\link{DESeqDataSet}} with true dispersion,
+#' intercept and beta values in the metadata columns. Note that the true
+#' betas are provided on the log2 scale.
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds
+#'
+#' @export
+makeExampleDESeqDataSet <- function(n=1000,m=12,betaSD=0,interceptMean=4,interceptSD=2,
+ dispMeanRel=function(x) 4/x + .1,sizeFactors=rep(1,m)) {
+ beta <- cbind(rnorm(n,interceptMean,interceptSD),rnorm(n,0,betaSD))
+ dispersion <- dispMeanRel(2^(beta[,1]))
+ colData <- DataFrame(condition=factor(rep(c("A","B"),times=c(ceiling(m/2),floor(m/2)))))
+ x <- if (m > 1) {
+ model.matrix(~ colData$condition)
+ } else {
+ cbind(rep(1,m),rep(0,m))
+ }
+ mu <- t(2^(x %*% t(beta)) * sizeFactors)
+ countData <- matrix(rnbinom(m*n, mu=mu, size=1/dispersion), ncol=m)
+ mode(countData) <- "integer"
+ colnames(countData) <- paste("sample",1:m,sep="")
+ rowRanges <- GRanges("1",IRanges(start=(1:n - 1) * 100 + 1,width=100))
+ names(rowRanges) <- paste0("gene",1:n)
+
+ # set environment to global environment,
+ # to avoid the formula carrying with it all the objects
+ # here including 'object' itself.
+ design <- if (m > 1) {
+ as.formula("~ condition", env=.GlobalEnv)
+ } else {
+ as.formula("~ 1", env=.GlobalEnv)
+ }
+
+ object <- DESeqDataSetFromMatrix(countData = countData,
+ colData = colData,
+ design = design,
+ rowRanges = rowRanges)
+ trueVals <- DataFrame(trueIntercept = beta[,1],
+ trueBeta = beta[,2],
+ trueDisp = dispersion)
+ mcols(trueVals) <- DataFrame(type=rep("input",ncol(trueVals)),
+ description=c("simulated intercept values",
+ "simulated beta values",
+ "simulated dispersion values"))
+ mcols(object) <- cbind(mcols(object),trueVals)
+ return(object)
+}
+
+
+#' Low-level function to estimate size factors with robust regression.
+#'
+#' Given a matrix or data frame of count data, this function estimates the size
+#' factors as follows: Each column is divided by the geometric means of the
+#' rows. The median (or, if requested, another location estimator) of these
+#' ratios (skipping the genes with a geometric mean of zero) is used as the size
+#' factor for this column. Typically, one will not call this function directly, but use
+#' \code{\link{estimateSizeFactors}}.
+#'
+#' @param counts a matrix or data frame of counts, i.e., non-negative integer
+#' values
+#' @param locfunc a function to compute a location for a sample. By default, the
+#' median is used. However, especially for low counts, the
+#' \code{\link[genefilter]{shorth}} function from genefilter may give better results.
+#' @param geoMeans by default this is not provided, and the
+#' geometric means of the counts are calculated within the function.
+#' A vector of geometric means from another count matrix can be provided
+#' for a "frozen" size factor calculation
+#' @param controlGenes optional, numeric or logical index vector specifying those genes to
+#' use for size factor estimation (e.g. housekeeping or spike-in genes)
+#' @return a vector with the estimates size factors, one element per column
+#' @author Simon Anders
+#' @seealso \code{\link{estimateSizeFactors}}
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' estimateSizeFactorsForMatrix(counts(dds))
+#' geoMeans <- exp(rowMeans(log(counts(dds))))
+#' estimateSizeFactorsForMatrix(counts(dds),geoMeans=geoMeans)
+#'
+#' @export
+estimateSizeFactorsForMatrix <- function( counts, locfunc = stats::median, geoMeans, controlGenes )
+{
+ if (missing(geoMeans)) {
+ loggeomeans <- rowMeans(log(counts))
+ } else {
+ if (length(geoMeans) != nrow(counts)) {
+ stop("geoMeans should be as long as the number of rows of counts")
+ }
+ loggeomeans <- log(geoMeans)
+ }
+ if (all(is.infinite(loggeomeans))) {
+ stop("every gene contains at least one zero, cannot compute log geometric means")
+ }
+ sf <- if (missing(controlGenes)) {
+ apply(counts, 2, function(cnts) {
+ exp(locfunc((log(cnts) - loggeomeans)[is.finite(loggeomeans) & cnts > 0]))
+ })
+ } else {
+ if ( !( is.numeric(controlGenes) | is.logical(controlGenes) ) ) {
+ stop("controlGenes should be either a numeric or logical vector")
+ }
+ loggeomeansSub <- loggeomeans[controlGenes]
+ apply(counts[controlGenes,,drop=FALSE], 2, function(cnts) {
+ exp(locfunc((log(cnts) - loggeomeansSub)[is.finite(loggeomeansSub) & cnts > 0]))
+ })
+ }
+ sf
+}
+
+#' Low-level functions to fit dispersion estimates
+#'
+#' Normal users should instead use \code{\link{estimateDispersions}}.
+#' These low-level functions are called by \code{\link{estimateDispersions}},
+#' but are exported and documented for non-standard usage.
+#' For instance, it is possible to replace fitted values with a custom fit and continue
+#' with the maximum a posteriori dispersion estimation, as demonstrated in the
+#' examples below.
+#'
+#' @param object a DESeqDataSet
+#' @param fitType either "parametric", "local", or "mean"
+#' for the type of fitting of dispersions to the mean intensity.
+#' See \code{\link{estimateDispersions}} for description.
+#' @param outlierSD the number of standard deviations of log
+#' gene-wise estimates above the prior mean (fitted value),
+#' above which dispersion estimates will be labelled
+#' outliers. Outliers will keep their original value and
+#' not be shrunk using the prior.
+#' @param dispPriorVar the variance of the normal prior on the log dispersions.
+#' If not supplied, this is calculated as the difference between
+#' the mean squared residuals of gene-wise estimates to the
+#' fitted dispersion and the expected sampling variance
+#' of the log dispersion
+#' @param minDisp small value for the minimum dispersion, to allow
+#' for calculations in log scale, one order of magnitude above this value is used
+#' as a test for inclusion in mean-dispersion fitting
+#' @param kappa_0 control parameter used in setting the initial proposal
+#' in backtracking search, higher kappa_0 results in larger steps
+#' @param dispTol control parameter to test for convergence of log dispersion,
+#' stop when increase in log posterior is less than dispTol
+#' @param maxit control parameter: maximum number of iterations to allow for convergence
+#' @param quiet whether to print messages at each step
+#' @param modelMatrix for advanced use only,
+#' a substitute model matrix for gene-wise and MAP dispersion estimation
+#' @param niter number of times to iterate between estimation of means and
+#' estimation of dispersion
+#'
+#' @return a DESeqDataSet with gene-wise, fitted, or final MAP
+#' dispersion estimates in the metadata columns of the object.
+#'
+#' \code{estimateDispersionsPriorVar} is called inside of \code{estimateDispersionsMAP}
+#' and stores the dispersion prior variance as an attribute of
+#' \code{dispersionFunction(dds)}, which can be manually provided to
+#' \code{estimateDispersionsMAP} for parallel execution.
+#'
+#' @aliases estimateDispersionsGeneEst estimateDispersionsFit estimateDispersionsMAP estimateDispersionsPriorVar
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersionsGeneEst(dds)
+#' dds <- estimateDispersionsFit(dds)
+#' dds <- estimateDispersionsMAP(dds)
+#' plotDispEsts(dds)
+#'
+#' # after having run estimateDispersionsFit()
+#' # the dispersion prior variance over all genes
+#' # can be obtained like so:
+#'
+#' dispPriorVar <- estimateDispersionsPriorVar(dds)
+#'
+#' @seealso \code{\link{estimateDispersions}}
+#'
+#' @export
+estimateDispersionsGeneEst <- function(object, minDisp=1e-8, kappa_0=1,
+ dispTol=1e-6, maxit=100, quiet=FALSE,
+ modelMatrix=NULL, niter=1) {
+ if (!is.null(mcols(object)$dispGeneEst)) {
+ if (!quiet) message("found already estimated gene-wise dispersions, removing these")
+ removeCols <- c("dispGeneEst")
+ mcols(object) <- mcols(object)[,!names(mcols(object)) %in% removeCols,drop=FALSE]
+ }
+ stopifnot(length(minDisp) == 1)
+ stopifnot(length(kappa_0) == 1)
+ stopifnot(length(dispTol) == 1)
+ stopifnot(length(maxit) == 1)
+ if (log(minDisp/10) <= -30) {
+ stop("for computational stability, log(minDisp/10) should be above -30")
+ }
+
+ # in case the class of the mcols(mcols(object)) are not character
+ object <- sanitizeRowRanges(object)
+
+ if (is.null(modelMatrix)) {
+ modelMatrix <- model.matrix(design(object), data=colData(object))
+ checkFullRank(modelMatrix)
+ if (nrow(modelMatrix) == ncol(modelMatrix)) {
+ stop("the number of samples and the number of model coefficients are equal,
+ i.e., there are no replicates to estimate the dispersion.
+ use an alternate design formula")
+ }
+ } else {
+ message("using supplied model matrix")
+ }
+
+ object <- getBaseMeansAndVariances(object)
+
+ # only continue on the rows with non-zero row mean
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+
+ # this rough dispersion estimate (alpha_hat)
+ # is for estimating mu
+ # and for the initial starting point for line search
+ # first check if model matrix is full rank
+ fullRank <- qr(modelMatrix)$rank == ncol(modelMatrix)
+ alpha_hat <- if (fullRank) {
+ # if full rank use this estimator which compares normalized counts to mu
+ roughDisp <- roughDispEstimate(y = counts(objectNZ,normalized=TRUE),
+ x = modelMatrix)
+ momentsDisp <- momentsDispEstimate(objectNZ)
+ pmin(roughDisp, momentsDisp)
+ } else {
+ # if not full rank use method of moments across all samples
+ momentsDispEstimate(objectNZ)
+ }
+
+ # bound the rough estimated alpha between minDisp and maxDisp for numeric stability
+ maxDisp <- max(10, ncol(object))
+ alpha_hat <- alpha_hat_new <- alpha_init <- pmin(pmax(minDisp, alpha_hat), maxDisp)
+
+ stopifnot(length(niter) == 1 & niter > 0)
+
+ # below, iterate between mean and dispersion estimation (niter) times
+ fitidx <- rep(TRUE,nrow(objectNZ))
+ mu <- matrix(0, nrow=nrow(objectNZ), ncol=ncol(objectNZ))
+ dispIter <- numeric(nrow(objectNZ))
+ # bound the estimated count at 0.1.
+ # this helps make the fitting more robust,
+ # because 1/mu occurs in the weights for the NB GLM
+ minmu <- 0.1
+ for (iter in seq_len(niter)) {
+ fit <- fitNbinomGLMs(objectNZ[fitidx,,drop=FALSE],
+ alpha_hat=alpha_hat[fitidx],
+ modelMatrix=modelMatrix)
+ fitMu <- fit$mu
+ fitMu[fitMu < minmu] <- minmu
+ mu[fitidx,] <- fitMu
+ # use of kappa_0 in backtracking search
+ # initial proposal = log(alpha) + kappa_0 * deriv. of log lik. w.r.t. log(alpha)
+ # use log(minDisp/10) to stop if dispersions going to -infinity
+ dispRes <- fitDispWrapper(ySEXP = counts(objectNZ)[fitidx,,drop=FALSE],
+ xSEXP = fit$modelMatrix,
+ mu_hatSEXP = fitMu,
+ log_alphaSEXP = log(alpha_hat)[fitidx],
+ log_alpha_prior_meanSEXP = log(alpha_hat)[fitidx],
+ log_alpha_prior_sigmasqSEXP = 1, min_log_alphaSEXP = log(minDisp/10),
+ kappa_0SEXP = kappa_0, tolSEXP = dispTol,
+ maxitSEXP = maxit, use_priorSEXP = FALSE)
+ dispIter[fitidx] <- dispRes$iter
+ alpha_hat_new[fitidx] <- pmin(exp(dispRes$log_alpha), maxDisp)
+ # only rerun those rows which moved
+ fitidx <- abs(log(alpha_hat_new) - log(alpha_hat)) > .05
+ alpha_hat <- alpha_hat_new
+ if (sum(fitidx) == 0) break
+ }
+
+ # dont accept moves if the log posterior did not
+ # increase by more than one millionth,
+ # and set the small estimates to the minimum dispersion
+ dispGeneEst <- alpha_hat
+ if (niter == 1) {
+ noIncrease <- dispRes$last_lp < dispRes$initial_lp + abs(dispRes$initial_lp)/1e6
+ dispGeneEst[which(noIncrease)] <- alpha_init[which(noIncrease)]
+ }
+ dispGeneEstConv <- dispIter < maxit
+
+ # when lacking convergence from the C++ routine
+ # we use an R function to estimate dispersions
+ # by evaluating a grid of posterior evaluations
+ refitDisp <- !dispGeneEstConv & dispGeneEst > minDisp*10
+ if (sum(refitDisp) > 0) {
+ dispGrid <- fitDispGridWrapper(y=counts(objectNZ)[refitDisp,,drop=FALSE],x=modelMatrix,
+ mu=mu[refitDisp,,drop=FALSE],
+ logAlphaPriorMean=rep(0,sum(refitDisp)),
+ logAlphaPriorSigmaSq=1,usePrior=FALSE)
+ dispGeneEst[refitDisp] <- dispGrid
+ }
+ dispGeneEst <- pmin(pmax(dispGeneEst, minDisp), maxDisp)
+
+ dispDataFrame <- buildDataFrameWithNARows(list(dispGeneEst=dispGeneEst),
+ mcols(object)$allZero)
+ mcols(dispDataFrame) <- DataFrame(type=rep("intermediate",ncol(dispDataFrame)),
+ description=c("gene-wise estimates of dispersion"))
+ mcols(object) <- cbind(mcols(object), dispDataFrame)
+ assays(object)[["mu"]] <- buildMatrixWithNARows(mu, mcols(object)$allZero)
+
+ return(object)
+}
+
+#' @rdname estimateDispersionsGeneEst
+#' @export
+estimateDispersionsFit <- function(object,fitType=c("parametric","local","mean"),
+ minDisp=1e-8, quiet=FALSE) {
+
+ if (is.null(mcols(object)$allZero)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+ useForFit <- mcols(objectNZ)$dispGeneEst > 100*minDisp
+ if (sum(useForFit) == 0) {
+ stop("all gene-wise dispersion estimates are within 2 orders of magnitude
+ from the minimum value, and so the standard curve fitting techniques will not work.
+ One can instead use the gene-wise estimates as final estimates:
+ dds <- estimateDispersionsGeneEst(dds)
+ dispersions(dds) <- mcols(dds)$dispGeneEst
+ ...then continue with testing using nbinomWaldTest or nbinomLRT")
+ }
+
+ fitType <- match.arg(fitType, choices=c("parametric","local","mean"))
+ stopifnot(length(fitType)==1)
+ stopifnot(length(minDisp)==1)
+ if (fitType == "parametric") {
+ trial <- try(dispFunction <- parametricDispersionFit(mcols(objectNZ)$baseMean[useForFit],
+ mcols(objectNZ)$dispGeneEst[useForFit]),
+ silent=TRUE)
+ if (inherits(trial,"try-error")) {
+ message("-- note: fitType='parametric', but the dispersion trend was not well captured by the
+ function: y = a/x + b, and a local regression fit was automatically substituted.
+ specify fitType='local' or 'mean' to avoid this message next time.")
+ fitType <- "local"
+ }
+ }
+ if (fitType == "local") {
+ dispFunction <- localDispersionFit(means = mcols(objectNZ)$baseMean[useForFit],
+ disps = mcols(objectNZ)$dispGeneEst[useForFit],
+ minDisp = minDisp)
+ }
+ if (fitType == "mean") {
+ useForMean <- mcols(objectNZ)$dispGeneEst > 10*minDisp
+ meanDisp <- mean(mcols(objectNZ)$dispGeneEst[useForMean],na.rm=TRUE,trim=0.001)
+ dispFunction <- function(means) meanDisp
+ attr( dispFunction, "mean" ) <- meanDisp
+ }
+ if (!(fitType %in% c("parametric","local","mean"))) {
+ stop("unknown fitType")
+ }
+
+ # store the dispersion function and attributes
+ attr( dispFunction, "fitType" ) <- fitType
+ if (quiet) {
+ suppressMessages({ dispersionFunction(object) <- dispFunction })
+ } else {
+ dispersionFunction(object) <- dispFunction
+ }
+
+ return(object)
+}
+
+#' @rdname estimateDispersionsGeneEst
+#' @export
+estimateDispersionsMAP <- function(object, outlierSD=2, dispPriorVar,
+ minDisp=1e-8, kappa_0=1, dispTol=1e-6,
+ maxit=100, modelMatrix=NULL, quiet=FALSE) {
+ stopifnot(length(outlierSD)==1)
+ stopifnot(length(minDisp)==1)
+ stopifnot(length(kappa_0)==1)
+ stopifnot(length(dispTol)==1)
+ stopifnot(length(maxit)==1)
+ if (is.null(mcols(object)$allZero)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+ if (!is.null(mcols(object)$dispersion)) {
+ if (!quiet) message("found already estimated dispersions, removing these")
+ removeCols <- c("dispersion","dispOutlier","dispMAP","dispIter","dispConv")
+ mcols(object) <- mcols(object)[,!names(mcols(object)) %in% removeCols,drop=FALSE]
+ }
+
+ if (is.null(modelMatrix)) {
+ modelMatrix <- model.matrix(design(object), data=colData(object))
+ } else {
+ message("using supplied model matrix")
+ }
+
+ # fill in the calculated dispersion prior variance
+ if (missing(dispPriorVar)) {
+ # if no gene-wise estimates above minimum
+ if (sum(mcols(object)$dispGeneEst >= minDisp*100,na.rm=TRUE) == 0) {
+ warning(paste0("all genes have dispersion estimates < ",minDisp*10,
+ ", returning disp = ",minDisp*10))
+ resultsList <- list(dispersion = rep(minDisp*10, sum(!mcols(object)$allZero)))
+ dispDataFrame <- buildDataFrameWithNARows(resultsList, mcols(object)$allZero)
+ mcols(dispDataFrame) <- DataFrame(type="intermediate",
+ description="final estimates of dispersion")
+ mcols(object) <- cbind(mcols(object), dispDataFrame)
+ dispFn <- dispersionFunction(object)
+ attr( dispFn, "dispPriorVar" ) <- 0.25
+ dispersionFunction(object, estimateVar=FALSE) <- dispFn
+ return(object)
+ }
+ dispPriorVar <- estimateDispersionsPriorVar(object, modelMatrix=modelMatrix)
+ dispFn <- dispersionFunction(object)
+ attr( dispFn, "dispPriorVar" ) <- dispPriorVar
+ dispersionFunction(object, estimateVar=FALSE) <- dispFn
+ } else {
+ dispFn <- dispersionFunction(object)
+ attr( dispFn, "dispPriorVar" ) <- dispPriorVar
+ dispersionFunction(object, estimateVar=FALSE) <- dispFn
+ }
+
+ stopifnot(length(dispPriorVar)==1)
+
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+ varLogDispEsts <- attr( dispersionFunction(object), "varLogDispEsts" )
+
+ # set prior variance for fitting dispersion
+ log_alpha_prior_sigmasq <- dispPriorVar
+
+ # get previously calculated mu
+ mu <- assays(objectNZ)[["mu"]]
+
+ # start fitting at gene estimate unless the points are one order of magnitude
+ # below the fitted line, then start at fitted line
+ dispInit <- ifelse(mcols(objectNZ)$dispGeneEst > 0.1 * mcols(objectNZ)$dispFit,
+ mcols(objectNZ)$dispGeneEst,
+ mcols(objectNZ)$dispFit)
+
+ # if any missing values, fill in the fitted value to initialize
+ dispInit[is.na(dispInit)] <- mcols(objectNZ)$dispFit[is.na(dispInit)]
+
+ # run with prior
+ dispResMAP <- fitDispWrapper(ySEXP = counts(objectNZ), xSEXP = modelMatrix, mu_hatSEXP = mu,
+ log_alphaSEXP = log(dispInit),
+ log_alpha_prior_meanSEXP = log(mcols(objectNZ)$dispFit),
+ log_alpha_prior_sigmasqSEXP = log_alpha_prior_sigmasq,
+ min_log_alphaSEXP = log(minDisp/10),
+ kappa_0SEXP = kappa_0, tolSEXP = dispTol,
+ maxitSEXP = maxit, use_priorSEXP = TRUE)
+
+ # prepare dispersions for storage in mcols(object)
+ dispMAP <- exp(dispResMAP$log_alpha)
+
+ # when lacking convergence from the C++ routine
+ # we use an R function to estimate dispersions.
+ # This finds the maximum of a smooth curve along a
+ # grid of posterior evaluations
+ dispConv <- dispResMAP$iter < maxit
+ refitDisp <- !dispConv
+ if (sum(refitDisp) > 0) {
+ dispInR <- fitDispGridWrapper(y = counts(objectNZ)[refitDisp,,drop=FALSE], x = modelMatrix,
+ mu = mu[refitDisp,,drop=FALSE],
+ logAlphaPriorMean = log(mcols(objectNZ)$dispFit)[refitDisp],
+ logAlphaPriorSigmaSq = log_alpha_prior_sigmasq,
+ usePrior=TRUE)
+ dispMAP[refitDisp] <- dispInR
+ }
+
+ # bound the dispersion estimate between minDisp and maxDisp for numeric stability
+ maxDisp <- max(10, ncol(object))
+ dispMAP <- pmin(pmax(dispMAP, minDisp), maxDisp)
+
+ dispersionFinal <- dispMAP
+
+ # detect outliers which have gene-wise estimates
+ # outlierSD * standard deviation of log gene-wise estimates
+ # above the fitted mean (prior mean)
+ # and keep the original gene-est value for these.
+ # Note: we use the variance of log dispersions estimates
+ # from all the genes, not only those from below
+ dispOutlier <- log(mcols(objectNZ)$dispGeneEst) >
+ log(mcols(objectNZ)$dispFit) +
+ outlierSD * sqrt(varLogDispEsts)
+ dispOutlier[is.na(dispOutlier)] <- FALSE
+ dispersionFinal[dispOutlier] <- mcols(objectNZ)$dispGeneEst[dispOutlier]
+
+ resultsList <- list(dispersion = dispersionFinal,
+ dispIter = dispResMAP$iter,
+ dispOutlier = dispOutlier,
+ dispMAP = dispMAP)
+
+ dispDataFrame <- buildDataFrameWithNARows(resultsList, mcols(object)$allZero)
+ mcols(dispDataFrame) <- DataFrame(type=rep("intermediate",ncol(dispDataFrame)),
+ description=c("final estimate of dispersion",
+ "number of iterations",
+ "dispersion flagged as outlier",
+ "maximum a posteriori estimate"))
+
+ mcols(object) <- cbind(mcols(object), dispDataFrame)
+ return(object)
+}
+
+#' @rdname estimateDispersionsGeneEst
+#' @export
+estimateDispersionsPriorVar <- function(object, minDisp=1e-8, modelMatrix=NULL) {
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+ aboveMinDisp <- mcols(objectNZ)$dispGeneEst >= minDisp*100
+ if (is.null(modelMatrix)) {
+ modelMatrix <- model.matrix(design(object), data=colData(object))
+ }
+ # estimate the variance of the distribution of the
+ # log dispersion estimates around the fitted value
+ dispResiduals <- log(mcols(objectNZ)$dispGeneEst) - log(mcols(objectNZ)$dispFit)
+ if (sum(aboveMinDisp,na.rm=TRUE) == 0) {
+ stop("no data found which is greater than minDisp")
+ }
+
+ varLogDispEsts <- attr(dispersionFunction(object), "varLogDispEsts")
+
+ m <- nrow(modelMatrix)
+ p <- ncol(modelMatrix)
+
+ # if the residual degrees of freedom is between 1 and 3, the distribution
+ # of log dispersions is especially asymmetric and poorly estimated
+ # by the MAD. we then use an alternate estimator, a monte carlo
+ # approach to match the distribution
+ if (((m - p) <= 3) & (m > p)) {
+ # in order to produce identical results we set the seed,
+ # and so we need to save and restore the .Random.seed value first
+ if (exists(".Random.seed")) {
+ oldRandomSeed <- .Random.seed
+ }
+ set.seed(2)
+ # The residuals are the observed distribution we try to match
+ obsDist <- dispResiduals[aboveMinDisp]
+ brks <- -20:20/2
+ obsDist <- obsDist[obsDist > min(brks) & obsDist < max(brks)]
+ obsVarGrid <- seq(from=0,to=8,length=200)
+ obsDistHist <- hist(obsDist,breaks=brks,plot=FALSE)
+ klDivs <- sapply(obsVarGrid, function(x) {
+ randDist <- log(rchisq(1e4,df=(m-p))) + rnorm(1e4,0,sqrt(x)) - log(m - p)
+ randDist <- randDist[randDist > min(brks) & randDist < max(brks)]
+ randDistHist <- hist(randDist,breaks=brks,plot=FALSE)
+ z <- c(obsDistHist$density,randDistHist$density)
+ small <- min(z[z > 0])
+ kl <- sum(obsDistHist$density * (log(obsDistHist$density + small) - log(randDistHist$density + small)))
+ kl
+ })
+ lofit <- loess(klDivs ~ obsVarGrid, span=.2)
+ obsVarFineGrid <- seq(from=0,to=8,length=1000)
+ lofitFitted <- predict(lofit,obsVarFineGrid)
+ argminKL <- obsVarFineGrid[which.min(lofitFitted)]
+ expVarLogDisp <- trigamma((m - p)/2)
+ dispPriorVar <- pmax(argminKL, 0.25)
+ # finally, restore the .Random.seed if it existed beforehand
+ if (exists("oldRandomSeed")) {
+ .Random.seed <<- oldRandomSeed
+ }
+
+ return(dispPriorVar)
+ }
+
+ # estimate the expected sampling variance of the log estimates
+ # Var(log(cX)) = Var(log(X))
+ # X ~ chi-squared with m - p degrees of freedom
+ if (m > p) {
+ expVarLogDisp <- trigamma((m - p)/2)
+ # set the variance of the prior using these two estimates
+ # with a minimum of .25
+ dispPriorVar <- pmax((varLogDispEsts - expVarLogDisp), 0.25)
+ } else {
+ # we have m = p, so do not try to subtract sampling variance
+ dispPriorVar <- varLogDispEsts
+ expVarLogDisp <- 0
+ }
+
+ dispPriorVar
+}
+
+
+
+#' Wald test for the GLM coefficients
+#'
+#' This function tests for significance of coefficients in a Negative
+#' Binomial GLM, using previously calculated \code{\link{sizeFactors}}
+#' (or \code{\link{normalizationFactors}})
+#' and dispersion estimates. See \code{\link{DESeq}} for the GLM formula.
+#'
+#' The fitting proceeds as follows: standard maximum likelihood estimates
+#' for GLM coefficients (synonymous with "beta", "log2 fold change", "effect size")
+#' are calculated. A zero-centered Normal prior distribution
+#' is assumed for the coefficients other than the intercept.
+#' The variance of the prior distribution for each
+#' non-intercept coefficient is calculated using the observed
+#' distribution of the maximum likelihood coefficients.
+#' The final coefficients are then maximum a posteriori estimates
+#' using this prior (Tikhonov/ridge regularization). See below for details on the
+#' prior variance and the Methods section of the DESeq2 manuscript for more detail.
+#' The use of a prior has little effect on genes with high counts and helps to
+#' moderate the large spread in coefficients for genes with low counts.
+#' For calculating Wald test p-values, the coefficients are scaled by their
+#' standard errors and then compared to a standard Normal distribution.
+#'
+#' The prior variance is calculated by matching the 0.05 upper quantile
+#' of the observed MLE coefficients to a zero-centered Normal distribution.
+#' In a change of methods since the 2014 paper,
+#' the weighted upper quantile is calculated using the
+#' \code{wtd.quantile} function from the Hmisc package. The weights are
+#' the inverse of the expected variance of log counts, so the inverse of
+#' \eqn{1/\bar{\mu} + \alpha_{tr}}{1/mu-bar + alpha_tr} using the mean of
+#' normalized counts and the trended dispersion fit. The weighting ensures
+#' that noisy estimates of log fold changes from small count genes do not
+#' overly influence the calculation of the prior variance.
+#' The final prior variance for a factor level is the average of the
+#' estimated prior variance over all contrasts of all levels of the factor.
+#' Another change since the 2014 paper: when interaction terms are present
+#' in the design, the prior on log fold changes is turned off
+#' (for more details, see the vignette section, "Methods changes since
+#' the 2014 DESeq2 paper").
+#'
+#' When a log2 fold change prior is used (betaPrior=TRUE),
+#' then \code{nbinomWaldTest} will by default use expanded model matrices,
+#' as described in the \code{modelMatrixType} argument, unless this argument
+#' is used to override the default behavior.
+#' This ensures that log2 fold changes will be independent of the choice
+#' of reference level. In this case, the beta prior variance for each factor
+#' is calculated as the average of the mean squared maximum likelihood
+#' estimates for each level and every possible contrast. The \code{\link{results}}
+#' function without any arguments will automatically perform a contrast of the
+#' last level of the last variable in the design formula over the first level.
+#' The \code{contrast} argument of the \code{\link{results}} function can be used
+#' to generate other comparisons.
+#'
+#' The Wald test can be replaced with the \code{\link{nbinomLRT}}
+#' for an alternative test of significance.
+#'
+#' @param object a DESeqDataSet
+#' @param betaPrior whether or not to put a zero-mean normal prior on
+#' the non-intercept coefficients
+#' @param betaPriorVar a vector with length equal to the number of
+#' model terms including the intercept.
+#' betaPriorVar gives the variance of the prior on the sample betas
+#' on the log2 scale. if missing (default) this is estimated from the data
+#' @param modelMatrix an optional matrix, typically this is set to NULL
+#' and created within the function. only can be supplied if betaPrior=FALSE
+#' @param modelMatrixType either "standard" or "expanded", which describe
+#' how the model matrix, X of the formula in \code{\link{DESeq}}, is
+#' formed. "standard" is as created by \code{model.matrix} using the
+#' design formula. "expanded" includes an indicator variable for each
+#' level of factors in addition to an intercept.
+#' betaPrior must be set to TRUE in order for expanded model matrices
+#' to be fit.
+#' @param maxit the maximum number of iterations to allow for convergence of the
+#' coefficient vector
+#' @param useOptim whether to use the native optim function on rows which do not
+#' converge within maxit
+#' @param quiet whether to print messages at each step
+#' @param useT whether to use a t-distribution as a null distribution,
+#' for significance testing of the Wald statistics.
+#' If FALSE, a standard normal null distribution is used.
+#' @param df the degrees of freedom for the t-distribution
+#' @param useQR whether to use the QR decomposition on the design
+#' matrix X while fitting the GLM
+#'
+#' @return a DESeqDataSet with results columns accessible
+#' with the \code{\link{results}} function. The coefficients and standard errors are
+#' reported on a log2 scale.
+#'
+#' @seealso \code{\link{DESeq}}, \code{\link{nbinomLRT}}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' dds <- nbinomWaldTest(dds)
+#' res <- results(dds)
+#'
+#' @export
+nbinomWaldTest <- function(object, betaPrior, betaPriorVar,
+ modelMatrix=NULL, modelMatrixType,
+ maxit=100, useOptim=TRUE, quiet=FALSE,
+ useT=FALSE, df, useQR=TRUE) {
+ if (is.null(dispersions(object))) {
+ stop("testing requires dispersion estimates, first call estimateDispersions()")
+ }
+ stopifnot(length(maxit)==1)
+ # in case the class of the mcols(mcols(object)) are not character
+ object <- sanitizeRowRanges(object)
+
+ if ("results" %in% mcols(mcols(object))$type) {
+ if (!quiet) message("found results columns, replacing these")
+ object <- removeResults(object)
+ }
+ if (is.null(mcols(object)$allZero)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+
+ # only continue on the rows with non-zero row mean
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+
+ if (is.null(modelMatrix)) {
+ modelAsFormula <- TRUE
+ termsOrder <- attr(terms.formula(design(object)),"order")
+ interactionPresent <- any(termsOrder > 1)
+ if (missing(betaPrior)) {
+ betaPrior <- !interactionPresent
+ }
+
+ # run some tests common to DESeq, nbinomWaldTest, nbinomLRT
+ designAndArgChecker(object, betaPrior)
+
+ # what kind of model matrix to use
+ stopifnot(is.logical(betaPrior))
+ blindDesign <- design(object) == formula(~ 1)
+ if (blindDesign) {
+ betaPrior <- FALSE
+ }
+ if (missing(modelMatrixType) || is.null(modelMatrixType)) {
+ modelMatrixType <- if (betaPrior) {
+ "expanded"
+ } else {
+ "standard"
+ }
+ }
+ if (modelMatrixType == "expanded" & !betaPrior) {
+ stop("expanded model matrices require a beta prior")
+ }
+ # store modelMatrixType so it can be accessed by estimateBetaPriorVar
+ attr(object, "modelMatrixType") <- modelMatrixType
+ hasIntercept <- attr(terms(design(object)),"intercept") == 1
+ renameCols <- hasIntercept
+ } else {
+ if (missing(betaPrior)) {
+ betaPrior <- FALSE
+ } else {
+ if (betaPrior) stop("the model matrix can only be user-supplied if betaPrior=FALSE")
+ }
+ message("using supplied model matrix")
+ modelAsFormula <- FALSE
+ attr(object, "modelMatrixType") <- "user-supplied"
+ renameCols <- FALSE
+ }
+
+ if (!betaPrior) {
+ # fit the negative binomial GLM without a prior
+ # (in actuality a very wide prior with standard deviation 1e3 on log2 fold changes)
+ fit <- fitNbinomGLMs(objectNZ, maxit=maxit, useOptim=useOptim, useQR=useQR,
+ renameCols=renameCols, modelMatrix=modelMatrix)
+ H <- fit$hat_diagonals
+ modelMatrix <- fit$modelMatrix
+ modelMatrixNames <- fit$modelMatrixNames
+ # record the wide prior variance which was used in fitting
+ betaPriorVar <- rep(1e6, ncol(fit$modelMatrix))
+ } else {
+ priorFitList <- fitGLMsWithPrior(object=object,
+ maxit=maxit, useOptim=useOptim, useQR=useQR,
+ betaPriorVar=betaPriorVar)
+ fit <- priorFitList$fit
+ H <- priorFitList$H
+ betaPriorVar <- priorFitList$betaPriorVar
+ modelMatrix <- priorFitList$modelMatrix
+ mleBetaMatrix <- priorFitList$mleBetaMatrix
+
+ # will add the MLE betas, so remove any which exist already
+ # (possibly coming from estimateMLEForBetaPriorVar)
+ mcols(object) <- mcols(object)[,grep("MLE_",names(mcols(object)),invert=TRUE)]
+ }
+
+ # store mu in case the user did not call estimateDispersionsGeneEst
+ dimnames(fit$mu) <- NULL
+ assays(objectNZ)[["mu"]] <- fit$mu
+ assays(object)[["mu"]] <- buildMatrixWithNARows(fit$mu, mcols(object)$allZero)
+
+ # store the prior variance directly as an attribute
+ # of the DESeqDataSet object, so it can be pulled later by
+ # the results function (necessary for setting max Cook's distance)
+ attr(object,"betaPrior") <- betaPrior
+ attr(object,"betaPriorVar") <- betaPriorVar
+ attr(object,"modelMatrix") <- modelMatrix
+ attr(object,"test") <- "Wald"
+
+ # calculate Cook's distance
+ dispModelMatrix <- if (modelAsFormula) {
+ model.matrix(design(object), data=colData(object))
+ } else {
+ modelMatrix
+ }
+ attr(object,"dispModelMatrix") <- dispModelMatrix
+ cooks <- calculateCooksDistance(objectNZ, H, dispModelMatrix)
+
+ # record maximum Cook's
+ maxCooks <- recordMaxCooks(design(object), colData(object), dispModelMatrix, cooks, nrow(objectNZ))
+
+ # store Cook's distance for each sample
+ assays(object)[["cooks"]] <- buildMatrixWithNARows(cooks, mcols(object)$allZero)
+
+ # add betas, standard errors and Wald p-values to the object
+ modelMatrixNames <- colnames(modelMatrix)
+ betaMatrix <- fit$betaMatrix
+ colnames(betaMatrix) <- modelMatrixNames
+ betaSE <- fit$betaSE
+ colnames(betaSE) <- paste0("SE_",modelMatrixNames)
+ WaldStatistic <- betaMatrix/betaSE
+ colnames(WaldStatistic) <- paste0("WaldStatistic_",modelMatrixNames)
+
+ # if useT is set to TRUE, use a t-distribution
+ if (useT) {
+ dispPriorVar <- attr( dispersionFunction(object), "dispPriorVar" )
+ stopifnot(length(df)==1)
+ WaldPvalue <- 2*pt(abs(WaldStatistic),df=df,lower.tail=FALSE)
+ } else {
+ WaldPvalue <- 2*pnorm(abs(WaldStatistic),lower.tail=FALSE)
+ }
+ colnames(WaldPvalue) <- paste0("WaldPvalue_",modelMatrixNames)
+
+ betaConv <- fit$betaConv
+
+ if (any(!betaConv)) {
+ if (!quiet) message(paste(sum(!betaConv),"rows did not converge in beta, labelled in mcols(object)$betaConv. Use larger maxit argument with nbinomWaldTest"))
+ }
+
+ mleBetas <- if (betaPrior) {
+ matrixToList(mleBetaMatrix)
+ } else {
+ NULL
+ }
+
+ resultsList <- c(matrixToList(betaMatrix),
+ matrixToList(betaSE),
+ mleBetas,
+ matrixToList(WaldStatistic),
+ matrixToList(WaldPvalue),
+ list(betaConv = betaConv,
+ betaIter = fit$betaIter,
+ deviance = -2 * fit$logLike,
+ maxCooks = maxCooks))
+
+ WaldResults <- buildDataFrameWithNARows(resultsList, mcols(object)$allZero)
+
+ modelMatrixNamesSpaces <- gsub("_"," ",modelMatrixNames)
+
+ lfcType <- if (attr(object,"betaPrior")) "MAP" else "MLE"
+ coefInfo <- paste(paste0("log2 fold change (",lfcType,"):"),modelMatrixNamesSpaces)
+ seInfo <- paste("standard error:",modelMatrixNamesSpaces)
+ mleInfo <- if (betaPrior) {
+ gsub("_"," ",colnames(mleBetaMatrix))
+ } else {
+ NULL
+ }
+ statInfo <- paste("Wald statistic:",modelMatrixNamesSpaces)
+ pvalInfo <- paste("Wald test p-value:",modelMatrixNamesSpaces)
+
+ mcols(WaldResults) <- DataFrame(type = rep("results",ncol(WaldResults)),
+ description = c(coefInfo, seInfo, mleInfo, statInfo, pvalInfo,
+ "convergence of betas",
+ "iterations for betas",
+ "deviance for the fitted model",
+ "maximum Cook's distance for row"))
+
+ mcols(object) <- cbind(mcols(object),WaldResults)
+ return(object)
+}
+
+
+
+#' Steps for estimating the beta prior variance
+#'
+#' These lower-level functions are called within \code{\link{DESeq}} or \code{\link{nbinomWaldTest}}.
+#' End users should use those higher-level function instead.
+#' NOTE: \code{estimateBetaPriorVar} returns a numeric vector, not a DESEqDataSet!
+#' For advanced users: to use these functions, first run \code{estimateMLEForBetaPriorVar}
+#' and then run \code{estimateBetaPriorVar}.
+#'
+#' @param object a DESeqDataSet
+#'
+#' @param maxit as defined in \code{link{nbinomWaldTest}}
+#' @param useOptim as defined in \code{link{nbinomWaldTest}}
+#' @param useQR as defined in \code{link{nbinomWaldTest}}
+#'
+#' @param betaPriorMethod the method for calculating the beta prior variance,
+#' either "quanitle" or "weighted":
+#' "quantile" matches a normal distribution using the upper quantile of the finite MLE betas.
+#' "weighted" matches a normal distribution using the upper quantile, but weighting by the variance of the MLE betas.
+#' @param upperQuantile the upper quantile to be used for the
+#' "quantile" or "weighted" method of beta prior variance estimation
+#'
+#'
+#' @return for \code{estimateMLEForBetaPriorVar}, a DESeqDataSet, with the
+#' necessary information stored in order to calculate the prior variance.
+#' for \code{estimateBetaPriorVar}, the vector of variances for the prior
+#' on the betas in the \code{\link{DESeq}} GLM
+#'
+#' @aliases estimateBetaPriorVar estimateMLEForBetaPriorVar
+#'
+#' @export
+estimateBetaPriorVar <- function(object,
+ betaPriorMethod=c("weighted","quantile"),
+ upperQuantile=.05) {
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+
+ betaMatrix <- as.matrix(mcols(objectNZ)[,grep("MLE_", names(mcols(object))),drop=FALSE])
+ colnamesBM <- colnames(betaMatrix)
+ colnamesBM <- gsub("MLE_(.*)","\\1",colnamesBM)
+
+ # renaming in reverse:
+ # make these standard colnames as from model.matrix()
+ convertNames <- renameModelMatrixColumns(colData(object),
+ design(object))
+ colnamesBM <- sapply(colnamesBM, function(x) {
+ if (x %in% convertNames$to) {
+ convertNames$from[convertNames$to == x]
+ } else {
+ x
+ }
+ })
+ colnames(betaMatrix) <- colnamesBM
+
+ # this is the model matrix from an MLE run
+ modelMatrix <- model.matrix(design(objectNZ), colData(object))
+
+ modelMatrixType <- attr(object, "modelMatrixType")
+
+ betaPriorMethod <- match.arg(betaPriorMethod, choices=c("weighted","quantile"))
+
+ # estimate the variance of the prior on betas
+ # if expanded, first calculate LFC for all possible contrasts
+ if (modelMatrixType == "expanded") {
+ betaMatrix <- addAllContrasts(objectNZ, betaMatrix)
+ }
+
+ # weighting by 1/Var(log(K))
+ # Var(log(K)) ~ Var(K)/mu^2 = 1/mu + alpha
+ # and using the fitted alpha
+ varlogk <- 1/mcols(objectNZ)$baseMean + mcols(objectNZ)$dispFit
+ weights <- 1/varlogk
+
+ betaPriorVar <- if (nrow(betaMatrix) > 1) {
+ apply(betaMatrix, 2, function(x) {
+ # this test removes genes which have betas
+ # tending to +/- infinity
+ useFinite <- abs(x) < 10
+ # if no more betas pass test, return wide prior
+ if (sum(useFinite) == 0 ) {
+ return(1e6)
+ } else {
+ if (betaPriorMethod=="quantile") {
+ return(matchUpperQuantileForVariance(x[useFinite],upperQuantile))
+ } else if (betaPriorMethod=="weighted") {
+ return(matchWeightedUpperQuantileForVariance(x[useFinite],weights[useFinite],upperQuantile))
+ }
+ }
+ })
+ } else {
+ (betaMatrix)^2
+ }
+ names(betaPriorVar) <- colnames(betaMatrix)
+
+ # pre-v1.10 code for interactions and beta prior:
+ # ------------------------------------------------------
+ # find the names of betaPriorVar which correspond
+ # to non-interaction terms and set these to a wide prior
+ ## termsOrder <- attr(terms.formula(design(object)),"order")
+ ## interactionPresent <- any(termsOrder > 1)
+ ## if (interactionPresent) {
+ ## nonInteractionCols <- getNonInteractionColumnIndices(objectNZ, modelMatrix)
+ ## if (modelMatrixType == "standard") widePrior <- 1e6 else widePrior <- 1e3
+ ## betaPriorVar[nonInteractionCols] <- widePrior
+ ## if (modelMatrixType == "expanded") {
+ ## # also set a wide prior for additional contrasts which were added
+ ## # for calculation of the prior variance in the case of
+ ## # expanded model matrices
+ ## designFactors <- getDesignFactors(objectNZ)
+ ## betaPriorVar[which(names(betaPriorVar) %in% paste0(designFactors,"Cntrst"))] <- widePrior
+ ## }
+ ## }
+
+ # intercept set to wide prior
+ if ("Intercept" %in% names(betaPriorVar)) {
+ betaPriorVar[which(names(betaPriorVar) == "Intercept")] <- 1e6
+ }
+
+ if (modelMatrixType == "expanded") {
+ # bring over beta priors from the GLM fit without prior.
+ # for factors: prior variance of each level are the average of the
+ # prior variances for the levels present in the previous GLM fit
+ betaPriorExpanded <- averagePriorsOverLevels(objectNZ, betaPriorVar)
+ betaPriorVar <- betaPriorExpanded
+ }
+
+ betaPriorVar
+}
+
+#' @rdname estimateBetaPriorVar
+#' @export
+estimateMLEForBetaPriorVar <- function(object, maxit=100, useOptim=TRUE, useQR=TRUE) {
+ # this function copies code from other functions,
+ # in order to allow parallelization
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+
+ # this code copied from nbinomWaldTest()
+ blindDesign <- design(object) == formula(~ 1)
+ mmTypeTest <- !blindDesign
+ modelMatrixType <- if (mmTypeTest) {
+ "expanded"
+ } else {
+ "standard"
+ }
+ attr(object, "modelMatrixType") <- modelMatrixType
+
+ # this code copied from fitGLMsWithPrior()
+ fit <- fitNbinomGLMs(objectNZ, maxit=maxit, useOptim=useOptim, useQR=useQR,
+ renameCols = (modelMatrixType == "standard"))
+ modelMatrix <- fit$modelMatrix
+ modelMatrixNames <- colnames(modelMatrix)
+ H <- fit$hat_diagonal
+ betaMatrix <- fit$betaMatrix
+
+ modelMatrixNames[modelMatrixNames == "(Intercept)"] <- "Intercept"
+ modelMatrixNames <- make.names(modelMatrixNames)
+ colnames(betaMatrix) <- modelMatrixNames
+
+ convertNames <- renameModelMatrixColumns(colData(object),
+ design(objectNZ))
+ convertNames <- convertNames[convertNames$from %in% modelMatrixNames,,drop=FALSE]
+ modelMatrixNames[match(convertNames$from, modelMatrixNames)] <- convertNames$to
+ mleBetaMatrix <- fit$betaMatrix
+ colnames(mleBetaMatrix) <- paste0("MLE_",modelMatrixNames)
+ # remove any MLE columns if they exist
+ mcols(object) <- mcols(object)[,grep("MLE_",names(mcols(object)),invert=TRUE)]
+ mcols(object) <- cbind(mcols(object), buildDataFrameWithNARows(DataFrame(mleBetaMatrix), mcols(object)$allZero))
+ assays(object)[["H"]] <- buildMatrixWithNARows(H, mcols(object)$allZero)
+ object
+}
+
+
+
+
+#' Likelihood ratio test (chi-squared test) for GLMs
+#'
+#' This function tests for significance of change in deviance between a
+#' full and reduced model which are provided as \code{formula}.
+#' Fitting uses previously calculated \code{\link{sizeFactors}} (or \code{\link{normalizationFactors}})
+#' and dispersion estimates.
+#'
+#' The difference in deviance is compared to a chi-squared distribution
+#' with df = (reduced residual degrees of freedom - full residual degrees of freedom).
+#' This function is comparable to the \code{nbinomGLMTest} of the previous version of DESeq
+#' and an alternative to the default \code{\link{nbinomWaldTest}}.
+#'
+#' @param object a DESeqDataSet
+#' @param full the full model formula, this should be the formula in
+#' \code{design(object)}.
+#' alternatively, can be a matrix
+#' @param reduced a reduced formula to compare against, e.g.
+#' the full model with a term or terms of interest removed.
+#' alternatively, can be a matrix
+#' @param betaPrior whether or not to put a zero-mean normal prior on
+#' the non-intercept coefficients
+#' While the beta prior is used typically, for the Wald test, it can
+#' also be specified for the likelihood ratio test. For more details
+#' on the calculation, see \code{\link{nbinomWaldTest}}.
+#' @param betaPriorVar a vector with length equal to the number of
+#' model terms including the intercept.
+# betaPriorVar gives the variance of the prior on the sample betas,
+#' which if missing is estimated from the rows which do not have any
+#' zeros
+#' @param maxit the maximum number of iterations to allow for convergence of the
+#' coefficient vector
+#' @param useOptim whether to use the native optim function on rows which do not
+#' converge within maxit
+#' @param quiet whether to print messages at each step
+#' @param useQR whether to use the QR decomposition on the design
+#' matrix X while fitting the GLM
+#'
+#' @return a DESeqDataSet with new results columns accessible
+#' with the \code{\link{results}} function. The coefficients and standard errors are
+#' reported on a log2 scale.
+#'
+#' @seealso \code{\link{DESeq}}, \code{\link{nbinomWaldTest}}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' dds <- nbinomLRT(dds, reduced = ~ 1)
+#' res <- results(dds)
+#'
+#' @export
+nbinomLRT <- function(object, full=design(object), reduced,
+ betaPrior=FALSE, betaPriorVar,
+ maxit=100, useOptim=TRUE, quiet=FALSE,
+ useQR=TRUE) {
+
+ if (is.null(dispersions(object))) {
+ stop("testing requires dispersion estimates, first call estimateDispersions()")
+ }
+ if (missing(reduced)) {
+ stop("provide a reduced formula for the LRT, e.g. nbinomLRT(object, reduced= ~1)")
+ }
+
+ # in case the class of the mcols(mcols(object)) are not character
+ object <- sanitizeRowRanges(object)
+
+ # run check on the formula
+ modelAsFormula <- !(is.matrix(full) & is.matrix(reduced))
+ if (modelAsFormula) {
+ checkLRT(full, reduced)
+
+ # run some tests common to DESeq, nbinomWaldTest, nbinomLRT
+ designAndArgChecker(object, betaPrior)
+
+ # try to form model matrices, test for difference
+ # in residual degrees of freedom
+ fullModelMatrix <- model.matrix(full,
+ data=colData(object))
+ reducedModelMatrix <- model.matrix(reduced,
+ data=colData(object))
+ df <- ncol(fullModelMatrix) - ncol(reducedModelMatrix)
+ } else {
+ if (betaPrior) {
+ stop("user-supplied model matrices require betaPrior=FALSE")
+ }
+ message("using supplied model matrix")
+ df <- ncol(full) - ncol(reduced)
+ }
+
+ if (df < 1) stop("less than one degree of freedom, perhaps full and reduced models are not in the correct order")
+
+ if (any(mcols(mcols(object))$type == "results")) {
+ if (!quiet) message("found results columns, replacing these")
+ object <- removeResults(object)
+ }
+
+ if (is.null(mcols(object)$allZero)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+
+ stopifnot(is.logical(betaPrior))
+ if (modelAsFormula) {
+ modelMatrixType <- "standard"
+ # check for intercept
+ hasIntercept <- attr(terms(design(object)),"intercept") == 1
+ renameCols <- hasIntercept
+ } else {
+ modelMatrixType <- "user-supplied"
+ renameCols <- FALSE
+ }
+
+ # store modelMatrixType so it can be accessed by estimateBetaPriorVar
+ attr(object,"modelMatrixType") <- modelMatrixType
+
+ # only continue on the rows with non-zero row mean
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+
+ if (!betaPrior) {
+ if (modelAsFormula) {
+ fullModel <- fitNbinomGLMs(objectNZ, modelFormula=full,
+ renameCols=renameCols, maxit=maxit,
+ useOptim=useOptim, useQR=useQR, warnNonposVar=FALSE)
+ modelMatrix <- fullModel$modelMatrix
+ reducedModel <- fitNbinomGLMs(objectNZ, modelFormula=reduced, maxit=maxit,
+ useOptim=useOptim, useQR=useQR, warnNonposVar=FALSE)
+ } else {
+ fullModel <- fitNbinomGLMs(objectNZ, modelMatrix=full,
+ renameCols=FALSE, maxit=maxit,
+ useOptim=useOptim, useQR=useQR, warnNonposVar=FALSE)
+ modelMatrix <- full
+ reducedModel <- fitNbinomGLMs(objectNZ, modelMatrix=reduced,
+ renameCols=FALSE, maxit=maxit,
+ useOptim=useOptim, useQR=useQR, warnNonposVar=FALSE)
+ }
+ betaPriorVar <- rep(1e6, ncol(modelMatrix))
+ } else {
+ priorFull <- fitGLMsWithPrior(object=object,
+ maxit=maxit, useOptim=useOptim, useQR=useQR,
+ betaPriorVar=betaPriorVar)
+ fullModel <- priorFull$fit
+ modelMatrix <- fullModel$modelMatrix
+ betaPriorVar <- priorFull$betaPriorVar
+ mleBetaMatrix <- priorFull$mleBetaMatrix
+ # form a reduced model matrix:
+ # first find the dropped terms
+ # then remove columns from the full model matrix which are
+ # assigned to these terms
+ fullModelTerms <- attr(terms(full),"term.labels")
+ reducedModelTerms <- attr(terms(reduced),"term.labels")
+ droppedTerms <- which(!fullModelTerms %in% reducedModelTerms)
+ fullAssign <- attr(modelMatrix,"assign")
+ idx <- !fullAssign %in% droppedTerms
+ # now subsetting the relevant columns
+ reducedModelMatrix <- modelMatrix[,idx,drop=FALSE]
+ reducedBetaPriorVar <- betaPriorVar[idx]
+ reducedLambda <- 1/reducedBetaPriorVar
+ reducedModel <- fitNbinomGLMs(objectNZ, modelMatrix=reducedModelMatrix,
+ lambda=reducedLambda,
+ maxit=maxit, useOptim=useOptim, useQR=useQR)
+ }
+
+ attr(object,"betaPrior") <- betaPrior
+ attr(object,"betaPriorVar") <- betaPriorVar
+ attr(object,"modelMatrix") <- modelMatrix
+ attr(object,"reducedModelMatrix") <- reducedModel$modelMatrix
+ attr(object,"test") <- "LRT"
+
+ # store mu in case the user did not call estimateDispersionsGeneEst
+ dimnames(fullModel$mu) <- NULL
+ assays(objectNZ)[["mu"]] <- fullModel$mu
+ assays(object)[["mu"]] <- buildMatrixWithNARows(fullModel$mu, mcols(object)$allZero)
+
+ H <- fullModel$hat_diagonals
+
+ # calculate Cook's distance
+ dispModelMatrix <- modelMatrix
+ attr(object,"dispModelMatrix") <- dispModelMatrix
+ cooks <- calculateCooksDistance(objectNZ, H, dispModelMatrix)
+
+ # record maximum of Cook's
+ maxCooks <- recordMaxCooks(design(object), colData(object), dispModelMatrix, cooks, nrow(objectNZ))
+
+ # store Cook's distance for each sample
+ assays(object)[["cooks"]] <- buildMatrixWithNARows(cooks, mcols(object)$allZero)
+
+ if (any(!fullModel$betaConv)) {
+ if (!quiet) message(paste(sum(!fullModel$betaConv),"rows did not converge in beta, labelled in mcols(object)$fullBetaConv. Use larger maxit argument with nbinomLRT"))
+ }
+
+ # calculate LRT statistic and p-values
+ LRTStatistic <- (2 * (fullModel$logLike - reducedModel$logLike))
+ LRTPvalue <- pchisq(LRTStatistic, df=df, lower.tail=FALSE)
+
+ mleBetas <- if (betaPrior) {
+ matrixToList(mleBetaMatrix)
+ } else {
+ NULL
+ }
+
+ # continue storing LRT results
+ resultsList <- c(matrixToList(fullModel$betaMatrix),
+ matrixToList(fullModel$betaSE),
+ mleBetas,
+ list(LRTStatistic = LRTStatistic,
+ LRTPvalue = LRTPvalue,
+ fullBetaConv = fullModel$betaConv,
+ reducedBetaConv = reducedModel$betaConv,
+ betaIter = fullModel$betaIter,
+ deviance = -2 * fullModel$logLike,
+ maxCooks = maxCooks))
+ LRTResults <- buildDataFrameWithNARows(resultsList, mcols(object)$allZero)
+
+ modelComparison <- if (modelAsFormula) {
+ paste0("'",paste(as.character(full),collapse=" "),
+ "' vs '", paste(as.character(reduced),collapse=" "),"'")
+ } else {
+ "full vs reduced"
+ }
+
+ modelMatrixNames <- colnames(fullModel$betaMatrix)
+ modelMatrixNamesSpaces <- gsub("_"," ",modelMatrixNames)
+ lfcType <- if (attr(object,"betaPrior")) "MAP" else "MLE"
+ coefInfo <- paste(paste0("log2 fold change (",lfcType,"):"),modelMatrixNamesSpaces)
+ seInfo <- paste("standard error:",modelMatrixNamesSpaces)
+ mleInfo <- if (betaPrior) {
+ gsub("_"," ",colnames(mleBetaMatrix))
+ } else {
+ NULL
+ }
+ statInfo <- paste("LRT statistic:",modelComparison)
+ pvalInfo <- paste("LRT p-value:",modelComparison)
+
+ mcols(LRTResults) <- DataFrame(type = rep("results",ncol(LRTResults)),
+ description = c(coefInfo, seInfo, mleInfo,
+ statInfo, pvalInfo,
+ "convergence of betas for full model",
+ "convergence of betas for reduced model",
+ "iterations for betas for full model",
+ "deviance of the full model",
+ "maximum Cook's distance for row"))
+ mcols(object) <- cbind(mcols(object),LRTResults)
+ return(object)
+}
+
+
+#' Replace outliers with trimmed mean
+#'
+#' Note that this function is called within \code{\link{DESeq}}, so is not
+#' necessary to call on top of a \code{DESeq} call. See the \code{minReplicatesForReplace}
+#' argument documented in \code{link{DESeq}}.
+#'
+#' This function replaces outlier counts flagged by extreme Cook's distances,
+#' as calculated by \code{\link{DESeq}}, \code{\link{nbinomWaldTest}}
+#' or \code{\link{nbinomLRT}}, with values predicted by the trimmed mean
+#' over all samples (and adjusted by size factor or normalization factor).
+#' This function replaces the counts in the matrix returned by \code{counts(dds)}
+#' and the Cook's distances in \code{assays(dds)[["cooks"]]}. Original counts are
+#' preserved in \code{assays(dds)[["originalCounts"]]}.
+#'
+#' The \code{\link{DESeq}} function calculates a diagnostic measure called
+#' Cook's distance for every gene and every sample. The \code{\link{results}}
+#' function then sets the p-values to \code{NA} for genes which contain
+#' an outlying count as defined by a Cook's distance above a threshold.
+#' With many degrees of freedom, i.e. many more samples than number of parameters to
+#' be estimated-- it might be undesirable to remove entire genes from the analysis
+#' just because their data include a single count outlier.
+#' An alternate strategy is to replace the outlier counts
+#' with the trimmed mean over all samples, adjusted by the size factor or normalization
+#' factor for that sample. The following simple function performs this replacement
+#' for the user, for samples which have at least \code{minReplicates} number
+#' of replicates (including that sample).
+#' For more information on Cook's distance, please see the two
+#' sections of the vignette: 'Dealing with count outliers' and 'Count outlier detection'.
+#'
+#' @param object a DESeqDataSet object, which has already been processed by
+#' either DESeq, nbinomWaldTest or nbinomLRT, and therefore contains a matrix
+#' contained in \code{assays(dds)[["cooks"]]}. These are the Cook's distances which will
+#' be used to define outlier counts.
+#' @param trim the fraction (0 to 0.5) of observations to be trimmed from
+#' each end of the normalized counts for a gene before the mean is computed
+#' @param cooksCutoff the threshold for defining an outlier to be replaced.
+#' Defaults to the .99 quantile of the F(p, m - p) distribution, where p is
+#' the number of parameters and m is the number of samples.
+#' @param minReplicates the minimum number of replicate samples necessary to consider
+#' a sample eligible for replacement (including itself). Outlier counts will not be replaced
+#' if the sample is in a cell which has less than minReplicates replicates.
+#' @param whichSamples optional, a numeric or logical index to specify
+#' which samples should have outliers replaced. if missing, this is determined using
+#' minReplicates.
+#'
+#' @seealso \code{\link{DESeq}}
+#'
+#' @aliases replaceOutliersWithTrimmedMean
+#'
+#' @return a DESeqDataSet with replaced counts in the slot returned by
+#' \code{\link{counts}} and the original counts preserved in
+#' \code{assays(dds)[["originalCounts"]]}
+#'
+#' @export
+replaceOutliers <- function(object, trim=.2, cooksCutoff, minReplicates=7, whichSamples) {
+ if (is.null(attr(object,"modelMatrix")) | !("cooks" %in% assayNames(object))) {
+ stop("first run DESeq, nbinomWaldTest, or nbinomLRT to identify outliers")
+ }
+ if (minReplicates < 3) {
+ stop("at least 3 replicates are necessary in order to indentify a sample as a count outlier")
+ }
+ stopifnot(is.numeric(minReplicates) & length(minReplicates) == 1)
+ p <- ncol(attr(object,"modelMatrix"))
+ m <- ncol(object)
+ if (m <= p) {
+ assays(object)[["originalCounts"]] <- counts(object)
+ return(object)
+ }
+ if (missing(cooksCutoff)) {
+ cooksCutoff <- qf(.99, p, m - p)
+ }
+ idx <- which(assays(object)[["cooks"]] > cooksCutoff)
+ mcols(object)$replace <- apply(assays(object)[["cooks"]], 1, function(row) any(row > cooksCutoff))
+ mcols(mcols(object),use.names=TRUE)["replace",] <- DataFrame(type="intermediate",description="had counts replaced")
+ trimBaseMean <- apply(counts(object,normalized=TRUE),1,mean,trim=trim)
+ # build a matrix of counts based on the trimmed mean and the size factors
+ replacementCounts <- if (!is.null(normalizationFactors(object))) {
+ as.integer(matrix(rep(trimBaseMean,ncol(object)),ncol=ncol(object)) *
+ normalizationFactors(object))
+ } else {
+ as.integer(outer(trimBaseMean, sizeFactors(object), "*"))
+ }
+
+ # replace only those values which fall above the cutoff on Cook's distance
+ newCounts <- counts(object)
+ newCounts[idx] <- replacementCounts[idx]
+
+ if (missing(whichSamples)) {
+ whichSamples <- nOrMoreInCell(attr(object,"modelMatrix"), n = minReplicates)
+ }
+ stopifnot(is.logical(whichSamples))
+ object$replaceable <- whichSamples
+ mcols(colData(object),use.names=TRUE)["replaceable",] <- DataFrame(type="intermediate",
+ description="outliers can be replaced")
+ assays(object)[["originalCounts"]] <- counts(object)
+ if (sum(whichSamples) == 0) {
+ return(object)
+ }
+ counts(object)[,whichSamples] <- newCounts[,whichSamples,drop=FALSE]
+ object
+}
+
+#' @export
+#' @rdname replaceOutliers
+replaceOutliersWithTrimmedMean <- replaceOutliers
+
+
+###########################################################
+# unexported functons
+###########################################################
+
+
+# Get base means and variances
+#
+# An internally used function to calculate the row means and variances
+# from the normalized counts, which requires that \code{\link{estimateSizeFactors}}
+# has already been called. Adds these and a logical column if the row sums
+# are zero to the mcols of the object.
+#
+# object a DESeqDataSet object
+#
+# return a DESeqDataSet object with columns baseMean
+# and baseVar in the row metadata columns
+getBaseMeansAndVariances <- function(object) {
+ meanVarZero <- DataFrame(baseMean = unname(rowMeans(counts(object,normalized=TRUE))),
+ baseVar = unname(rowVars(counts(object,normalized=TRUE))),
+ allZero = unname(rowSums(counts(object)) == 0))
+ mcols(meanVarZero) <- DataFrame(type = rep("intermediate",ncol(meanVarZero)),
+ description = c("mean of normalized counts for all samples",
+ "variance of normalized counts for all samples",
+ "all counts for a gene are zero"))
+ if (all(c("baseMean","baseVar","allZero") %in% names(mcols(object)))) {
+ mcols(object)[c("baseMean","baseVar","allZero")] <- meanVarZero
+ } else {
+ mcols(object) <- cbind(mcols(object),meanVarZero)
+ }
+ return(object)
+}
+
+estimateNormFactors <- function(counts, normMatrix, locfunc=median, geoMeans, controlGenes) {
+ sf <- estimateSizeFactorsForMatrix(counts / normMatrix, locfunc=locfunc, geoMeans=geoMeans, controlGenes=controlGenes)
+ nf <- t( t(normMatrix) * sf )
+ nf / exp(rowMeans(log(nf)))
+}
+
+# Estimate a parametric fit of dispersion to the mean intensity
+parametricDispersionFit <- function( means, disps ) {
+ coefs <- c( .1, 1 )
+ iter <- 0
+ while(TRUE) {
+ residuals <- disps / ( coefs[1] + coefs[2] / means )
+ good <- which( (residuals > 1e-4) & (residuals < 15) )
+ # check for glm convergence below to exit while-loop
+ suppressWarnings({fit <- glm( disps[good] ~ I(1/means[good]),
+ family=Gamma(link="identity"), start=coefs )})
+ oldcoefs <- coefs
+ coefs <- coefficients(fit)
+ if ( !all( coefs > 0 ) )
+ stop(simpleError("parametric dispersion fit failed"))
+ if ( ( sum( log( coefs / oldcoefs )^2 ) < 1e-6 ) & fit$converged )
+ break
+ iter <- iter + 1
+ if ( iter > 10 )
+ stop(simpleError("dispersion fit did not converge"))
+ }
+ names( coefs ) <- c( "asymptDisp", "extraPois" )
+ ans <- function(q) coefs[1] + coefs[2] / q
+ attr( ans, "coefficients" ) <- coefs
+ ans
+}
+
+
+# Local fit of dispersion to the mean intensity
+# fitting is done on log dispersion, log mean scale
+localDispersionFit <- function( means, disps, minDisp ) {
+ if (all(disps < minDisp*10)) {
+ return(rep(minDisp,length(disps)))
+ }
+ d <- data.frame(logDisps = log(disps), logMeans = log(means))
+ fit <- locfit(logDisps ~ logMeans, data=d[disps >= minDisp*10,,drop=FALSE],
+ weights = means[disps >= minDisp*10])
+ dispFunction <- function(means) exp(predict(fit, data.frame(logMeans=log(means))))
+ return(dispFunction)
+}
+
+
+# convenience function for testing the log likelihood
+# for a count matrix, mu matrix and vector disp
+nbinomLogLike <- function(counts, mu, disp) {
+ rowSums(matrix(dnbinom(counts, mu=mu,size=1/disp,
+ log=TRUE),ncol=ncol(counts)))
+}
+
+
+# Unexported, low-level function for fitting negative binomial GLMs
+#
+# Users typically call \code{\link{nbinomWaldTest}} or \code{\link{nbinomLRT}}
+# which calls this function to perform fitting. These functions return
+# a \code{\link{DESeqDataSet}} object with the appropriate columns
+# added. This function returns results as a list.
+#
+# object a DESeqDataSet
+# modelMatrix the design matrix
+# modelFormula a formula specifying how to construct the design matrix
+# alpha_hat the dispersion parameter estimates
+# lambda the 'ridge' term added for the penalized GLM on the log2 scale
+# renameCols whether to give columns variable_B_vs_A style names
+# betaTol control parameter: stop when the following is satisfied:
+# abs(dev - dev_old)/(abs(dev) + 0.1) < betaTol
+# maxit control parameter: maximum number of iteration to allow for
+# convergence
+# useOptim whether to use optim on rows which have not converged:
+# Fisher scoring is not ideal with multiple groups and sparse
+# count distributions
+# useQR whether to use the QR decomposition on the design matrix X
+# forceOptim whether to use optim on all rows
+# warnNonposVar whether to warn about non positive variances,
+# for advanced users only running LRT without beta prior,
+# this might be desirable to be ignored.
+#
+# return a list of results, with coefficients and standard
+# errors on the log2 scale
+fitNbinomGLMs <- function(object, modelMatrix=NULL, modelFormula, alpha_hat, lambda,
+ renameCols=TRUE, betaTol=1e-8, maxit=100, useOptim=TRUE,
+ useQR=TRUE, forceOptim=FALSE, warnNonposVar=TRUE) {
+ if (missing(modelFormula)) {
+ modelFormula <- design(object)
+ }
+ if (is.null(modelMatrix)) {
+ modelAsFormula <- TRUE
+ modelMatrix <- model.matrix(modelFormula, data=colData(object))
+ } else {
+ modelAsFormula <- FALSE
+ }
+
+ stopifnot(all(colSums(abs(modelMatrix)) > 0))
+
+ # rename columns, for use as columns in DataFrame
+ # and to emphasize the reference level comparison
+ modelMatrixNames <- colnames(modelMatrix)
+ modelMatrixNames[modelMatrixNames == "(Intercept)"] <- "Intercept"
+ modelMatrixNames <- make.names(modelMatrixNames)
+
+ if (renameCols) {
+ convertNames <- renameModelMatrixColumns(colData(object),
+ modelFormula)
+ convertNames <- convertNames[convertNames$from %in% modelMatrixNames,,drop=FALSE]
+ modelMatrixNames[match(convertNames$from, modelMatrixNames)] <- convertNames$to
+ }
+ colnames(modelMatrix) <- modelMatrixNames
+
+ normalizationFactors <- if (!is.null(normalizationFactors(object))) {
+ normalizationFactors(object)
+ } else {
+ matrix(rep(sizeFactors(object),each=nrow(object)),
+ ncol=ncol(object))
+ }
+
+ if (missing(alpha_hat)) {
+ alpha_hat <- dispersions(object)
+ }
+
+ if (length(alpha_hat) != nrow(object)) {
+ stop("alpha_hat needs to be the same length as nrows(object)")
+ }
+
+ # set a wide prior for all coefficients
+ if (missing(lambda)) {
+ lambda <- rep(1e-6, ncol(modelMatrix))
+ }
+
+ # bypass the beta fitting if the model formula is only intercept and
+ # the prior variance is large (1e6)
+ # i.e., LRT with reduced ~ 1 and no beta prior
+ justIntercept <- if (modelAsFormula) {
+ modelFormula == formula(~ 1)
+ } else {
+ ncol(modelMatrix) == 1 & all(modelMatrix == 1)
+ }
+ if (justIntercept & all(lambda <= 1e-6)) {
+ alpha <- alpha_hat
+ betaConv <- rep(TRUE, nrow(object))
+ betaIter <- rep(1,nrow(object))
+ betaMatrix <- matrix(log2(mcols(object)$baseMean),ncol=1)
+ mu <- normalizationFactors * as.numeric(2^betaMatrix)
+ logLike <- rowSums(dnbinom(counts(object), mu=mu, size=1/alpha, log=TRUE))
+ deviance <- -2 * logLike
+ modelMatrix <- model.matrix(~ 1, colData(object))
+ colnames(modelMatrix) <- modelMatrixNames <- "Intercept"
+ w <- (mu^-1 + alpha)^-1
+ xtwx <- rowSums(w)
+ sigma <- xtwx^-1
+ betaSE <- matrix(log2(exp(1)) * sqrt(sigma),ncol=1)
+ hat_diagonals <- w * xtwx^-1;
+ res <- list(logLike = logLike, betaConv = betaConv, betaMatrix = betaMatrix,
+ betaSE = betaSE, mu = mu, betaIter = betaIter,
+ deviance = deviance,
+ modelMatrix=modelMatrix,
+ nterms=1, hat_diagonals=hat_diagonals)
+ return(res)
+ }
+
+ qrx <- qr(modelMatrix)
+ # if full rank, estimate initial betas for IRLS below
+ if (qrx$rank == ncol(modelMatrix)) {
+ Q <- qr.Q(qrx)
+ R <- qr.R(qrx)
+ y <- t(log(counts(object,normalized=TRUE) + .1))
+ beta_mat <- t(solve(R, t(Q) %*% y))
+ } else {
+ if ("Intercept" %in% modelMatrixNames) {
+ beta_mat <- matrix(0, ncol=ncol(modelMatrix), nrow=nrow(object))
+ # use the natural log as fitBeta occurs in the natural log scale
+ logBaseMean <- log(rowMeans(counts(object,normalized=TRUE)))
+ beta_mat[,which(modelMatrixNames == "Intercept")] <- logBaseMean
+ } else {
+ beta_mat <- matrix(1, ncol=ncol(modelMatrix), nrow=nrow(object))
+ }
+ }
+
+ # here we convert from the log2 scale of the betas
+ # and the beta prior variance to the log scale
+ # used in fitBeta.
+ # so we divide by the square of the
+ # conversion factor, log(2)
+ lambdaLogScale <- lambda / log(2)^2
+
+ betaRes <- fitBetaWrapper(ySEXP = counts(object), xSEXP = modelMatrix,
+ nfSEXP = normalizationFactors,
+ alpha_hatSEXP = alpha_hat,
+ beta_matSEXP = beta_mat,
+ lambdaSEXP = lambdaLogScale,
+ tolSEXP = betaTol, maxitSEXP = maxit,
+ useQRSEXP=useQR)
+ mu <- normalizationFactors * t(exp(modelMatrix %*% t(betaRes$beta_mat)))
+ dispersionVector <- rep(dispersions(object), times=ncol(object))
+ logLike <- nbinomLogLike(counts(object), mu, dispersions(object))
+
+ # test for stability
+ rowStable <- apply(betaRes$beta_mat,1,function(row) sum(is.na(row))) == 0
+
+ # test for positive variances
+ rowVarPositive <- apply(betaRes$beta_var_mat,1,function(row) sum(row <= 0)) == 0
+
+ # test for convergence, stability and positive variances
+ betaConv <- betaRes$iter < maxit
+
+ # here we transform the betaMatrix and betaSE to a log2 scale
+ betaMatrix <- log2(exp(1))*betaRes$beta_mat
+ colnames(betaMatrix) <- modelMatrixNames
+ colnames(modelMatrix) <- modelMatrixNames
+ # warn below regarding these rows with negative variance
+ betaSE <- log2(exp(1))*sqrt(pmax(betaRes$beta_var_mat,0))
+ colnames(betaSE) <- paste0("SE_",modelMatrixNames)
+
+ # switch based on whether we should also use optim
+ # on rows which did not converge
+ rowsForOptim <- if (useOptim) {
+ which(!betaConv | !rowStable | !rowVarPositive)
+ } else {
+ which(!rowStable | !rowVarPositive)
+ }
+
+ if (forceOptim) {
+ rowsForOptim <- seq_along(betaConv)
+ }
+
+ if (length(rowsForOptim) > 0) {
+ # we use optim if didn't reach convergence with the IRLS code
+ resOptim <- fitNbinomGLMsOptim(object,modelMatrix,lambda,
+ rowsForOptim,rowStable,
+ normalizationFactors,alpha_hat,
+ betaMatrix,betaSE,betaConv,
+ beta_mat,
+ mu,logLike)
+ betaMatrix <- resOptim$betaMatrix
+ betaSE <- resOptim$betaSE
+ betaConv <- resOptim$betaConv
+ mu <- resOptim$mu
+ logLike <- resOptim$logLike
+ }
+
+ stopifnot(!any(is.na(betaSE)))
+ nNonposVar <- sum(rowSums(betaSE == 0) > 0)
+ if (warnNonposVar & nNonposVar > 0) warning(nNonposVar,"rows had non-positive estimates of variance for coefficients")
+
+ list(logLike = logLike, betaConv = betaConv, betaMatrix = betaMatrix,
+ betaSE = betaSE, mu = mu, betaIter = betaRes$iter,
+ deviance = betaRes$deviance,
+ modelMatrix=modelMatrix,
+ nterms=ncol(modelMatrix), hat_diagonals=betaRes$hat_diagonals)
+}
+
+
+# Fit dispersions for negative binomial GLM
+#
+# This function estimates the dispersion parameter (alpha) for negative binomial
+# generalized linear models. The fitting is performed on the log scale.
+#
+# ySEXP n by m matrix of counts
+# xSEXP m by k design matrix
+# mu_hatSEXP n by m matrix, the expected mean values, given beta-hat
+# log_alphaSEXP n length vector of initial guesses for log(alpha)
+# log_alpha_prior_meanSEXP n length vector of the fitted values for log(alpha)
+# log_alpha_prior_sigmasqSEXP a single numeric value for the variance of the prior
+# min_log_alphaSEXP the minimum value of log alpha
+# kappa_0SEXP a parameter used in calculting the initial proposal
+# for the backtracking search
+# initial proposal = log(alpha) + kappa_0 * deriv. of log lik. w.r.t. log(alpha)
+# tolSEXP tolerance for convergence in estimates
+# maxitSEXP maximum number of iterations
+# use_priorSEXP boolean variable, whether to use a prior or just calculate the MLE
+#
+# return a list with elements: log_alpha, iter, iter_accept, last_change, initial_lp, intial_dlp, last_lp, last_dlp, last_d2lp
+fitDispWrapper <- function (ySEXP, xSEXP, mu_hatSEXP, log_alphaSEXP, log_alpha_prior_meanSEXP,
+ log_alpha_prior_sigmasqSEXP, min_log_alphaSEXP, kappa_0SEXP,
+ tolSEXP, maxitSEXP, use_priorSEXP) {
+ # test for any NAs in arguments
+ arg.names <- names(formals(fitDispWrapper))
+ na.test <- sapply(mget(arg.names), function(x) any(is.na(x)))
+ if (any(na.test)) stop(paste("in call to fitDisp, the following arguments contain NA:",
+ paste(arg.names[na.test],collapse=", ")))
+ fitDisp(ySEXP=ySEXP, xSEXP=xSEXP, mu_hatSEXP=mu_hatSEXP,
+ log_alphaSEXP=log_alphaSEXP, log_alpha_prior_meanSEXP=log_alpha_prior_meanSEXP,
+ log_alpha_prior_sigmasqSEXP=log_alpha_prior_sigmasqSEXP,
+ min_log_alphaSEXP=min_log_alphaSEXP, kappa_0SEXP=kappa_0SEXP,
+ tolSEXP=tolSEXP, maxitSEXP=maxitSEXP, use_priorSEXP=use_priorSEXP)
+}
+
+
+# Fit beta coefficients for negative binomial GLM
+#
+# This function estimates the coefficients (betas) for negative binomial generalized linear models.
+#
+# ySEXP n by m matrix of counts
+# xSEXP m by k design matrix
+# nfSEXP n by m matrix of normalization factors
+# alpha_hatSEXP n length vector of the disperion estimates
+# contrastSEXP a k length vector for a possible contrast
+# beta_matSEXP n by k matrix of the initial estimates for the betas
+# lambdaSEXP k length vector of the ridge values
+# tolSEXP tolerance for convergence in estimates
+# maxitSEXP maximum number of iterations
+# useQRSEXP whether to use QR decomposition
+#
+# Note: at this level the betas are on the natural log scale
+fitBetaWrapper <- function (ySEXP, xSEXP, nfSEXP, alpha_hatSEXP, contrastSEXP,
+ beta_matSEXP, lambdaSEXP, tolSEXP, maxitSEXP, useQRSEXP) {
+ if ( missing(contrastSEXP) ) {
+ # contrast is not required, just give 1,0,0,...
+ contrastSEXP <- c(1,rep(0,ncol(xSEXP)-1))
+ }
+ # test for any NAs in arguments
+ arg.names <- names(formals(fitBetaWrapper))
+ na.test <- sapply(mget(arg.names), function(x) any(is.na(x)))
+ if (any(na.test)) stop(paste("in call to fitBeta, the following arguments contain NA:",
+ paste(arg.names[na.test],collapse=", ")))
+
+ fitBeta(ySEXP=ySEXP, xSEXP=xSEXP, nfSEXP=nfSEXP, alpha_hatSEXP=alpha_hatSEXP,
+ contrastSEXP=contrastSEXP, beta_matSEXP=beta_matSEXP,
+ lambdaSEXP=lambdaSEXP, tolSEXP=tolSEXP, maxitSEXP=maxitSEXP,
+ useQRSEXP=useQRSEXP)
+}
+
+
+# convenience function for building results tables
+# out of a list and filling in NA rows
+buildDataFrameWithNARows <- function(resultsList, NArows) {
+ lengths <- sapply(resultsList,length)
+ if (!all(lengths == lengths[1])) {
+ stop("lengths of vectors in resultsList must be equal")
+ }
+ if (sum(!NArows) != lengths[1]) {
+ stop("number of non-NA rows must be equal to lengths of vectors in resultsList")
+ }
+ if (sum(NArows) == 0) {
+ return(DataFrame(resultsList))
+ }
+ dfFull <- DataFrame(lapply(resultsList, function(x) vector(mode(x), length(NArows))))
+ dfFull[NArows,] <- NA
+ dfFull[!NArows,] <- DataFrame(resultsList)
+ dfFull
+}
+
+# convenience function for building larger matrices
+# by filling in NA rows
+buildMatrixWithNARows <- function(m, NARows) {
+ mFull <- matrix(NA, ncol=ncol(m), nrow=length(NARows))
+ mFull[!NARows,] <- m
+ mFull
+}
+
+# convenience function for building larger matrices
+# by filling in 0 rows
+buildMatrixWithZeroRows <- function(m, zeroRows) {
+ mFull <- matrix(0, ncol=ncol(m), nrow=length(zeroRows))
+ mFull[!zeroRows,] <- m
+ mFull
+}
+
+# convenience function for breaking up matrices
+# by column and preserving column names
+matrixToList <- function(m) {
+ l <- split(m, col(m))
+ names(l) <- colnames(m)
+ l
+}
+
+
+# calculate a robust method of moments dispersion,
+# in order to estimate the dispersion excluding
+# individual outlier counts which would raise the variance estimate
+robustMethodOfMomentsDisp <- function(object, modelMatrix) {
+ cnts <- counts(object,normalized=TRUE)
+ # if there are 3 or more replicates in any cell
+ threeOrMore <- nOrMoreInCell(modelMatrix,n=3)
+ v <- if (any(threeOrMore)) {
+ cells <- apply(modelMatrix,1,paste0,collapse="")
+ cells <- unname(factor(cells,levels=unique(cells)))
+ levels(cells) <- seq_along(levels(cells))
+ levelsThreeOrMore <- levels(cells)[table(cells) >= 3]
+ idx <- cells %in% levelsThreeOrMore
+ cntsSub <- cnts[,idx,drop=FALSE]
+ cellsSub <- factor(cells[idx])
+ trimmedCellVariance(cntsSub, cellsSub)
+ } else {
+ trimmedVariance(cnts)
+ }
+ m <- rowMeans(cnts)
+ alpha <- ( v - m ) / m^2
+ # cannot use the typical minDisp = 1e-8 here or else all counts in the same
+ # group as the outlier count will get an extreme Cook's distance
+ minDisp <- 0.04
+ alpha <- pmax(alpha, minDisp)
+ alpha
+}
+
+trimmedCellVariance <- function(cnts, cells) {
+ # how much to trim at different n
+ trimratio <- c(1/3, 1/4, 1/8)
+ # returns an index for the vector above for three sample size bins
+ trimfn <- function(n) as.integer(cut(n, breaks=c(0,3.5,23.5,Inf)))
+ cellMeans <- matrix(sapply(levels(cells), function(lvl) {
+ n <- sum(cells==lvl)
+ apply(cnts[,cells==lvl,drop=FALSE],1,mean,trim=trimratio[trimfn(n)])
+ }),
+ nrow=nrow(cnts))
+ qmat <- cellMeans[,as.integer(cells),drop=FALSE]
+ sqerror <- (cnts - qmat)^2
+ varEst <- matrix(sapply(levels(cells), function(lvl) {
+ n <- sum(cells==lvl)
+ # scale due to trimming of large squares, by e.g. 1/mean(rnorm(1e6)^2,trim=1/8)
+ scale.c <- c(2.04, 1.86, 1.51)[trimfn(n)]
+ scale.c * apply(sqerror[,cells==lvl,drop=FALSE],1,mean,trim=trimratio[trimfn(n)])
+ }),
+ nrow=nrow(sqerror))
+ # take the max of variance estimates from cells
+ # as one condition might have highly variable counts
+ rowMax(varEst)
+}
+
+trimmedVariance <- function(x) {
+ rm <- apply(x,1,mean,trim=1/8)
+ sqerror <- (x - rm)^2
+ # scale due to trimming of large squares
+ 1.51 * apply(sqerror,1,mean,trim=1/8)
+}
+
+calculateCooksDistance <- function(object, H, modelMatrix) {
+ p <- ncol(modelMatrix)
+ dispersions <- robustMethodOfMomentsDisp(object, modelMatrix)
+ V <- assays(object)[["mu"]] + dispersions * assays(object)[["mu"]]^2
+ PearsonResSq <- (counts(object) - assays(object)[["mu"]])^2 / V
+ cooks <- PearsonResSq / p * H / (1 - H)^2
+ cooks
+}
+
+
+# this function breaks out the logic for calculating the max Cook's distance:
+# the samples over which max Cook's distance is calculated:
+#
+# Cook's distance is considered for those samples with 3 or more replicates per cell
+#
+# if m == p or there are no samples over which to calculate max Cook's, then give NA
+recordMaxCooks <- function(design, colData, modelMatrix, cooks, numRow) {
+ samplesForCooks <- nOrMoreInCell(modelMatrix, n=3)
+ p <- ncol(modelMatrix)
+ m <- nrow(modelMatrix)
+ maxCooks <- if ((m > p) & any(samplesForCooks)) {
+ apply(cooks[,samplesForCooks,drop=FALSE], 1, max)
+ } else {
+ rep(NA, numRow)
+ }
+ maxCooks
+}
+
+# for each sample in the model matrix,
+# are there n or more replicates in the same cell
+# (including that sample)
+# so for a 2 x 3 comparison, the returned vector for n = 3 is:
+# FALSE, FALSE, TRUE, TRUE, TRUE
+nOrMoreInCell <- function(modelMatrix, n) {
+ numEqual <- sapply(seq_len(nrow(modelMatrix)), function(i) {
+ modelMatrixDiff <- t(t(modelMatrix) - modelMatrix[i,])
+ sum(apply(modelMatrixDiff, 1, function(row) all(row == 0)))
+ })
+ numEqual >= n
+}
+
+# returns TRUE or FALSE if removing row would leave matrix full rank
+## leaveOneOutFullRank <- function(modelMatrix) {
+## sapply(seq_len(nrow(modelMatrix)), function(i) qr(modelMatrix[-i,,drop=FALSE])$rank) == ncol(modelMatrix)
+## }
+
+
+# an unexported diagnostic function
+# to retrieve the covariance matrix
+# for the GLM coefficients of a single row
+# only for standard model matrices
+covarianceMatrix <- function(object, rowNumber) {
+ if (attr(object, "modelMatrixType") != "standard")
+ stop("only for standard model matrices")
+ # convert coefficients to log scale
+ coefColumns <- names(mcols(object))[grep("log2 fold change",mcols(mcols(object))$description)]
+ beta <- log(2) * as.numeric(as.data.frame(mcols(object)[rowNumber,coefColumns,drop=FALSE]))
+ x <- model.matrix(design(object), colData(object))
+ y <- counts(object)[rowNumber,]
+ sf <- sizeFactors(object)
+ alpha <- dispersions(object)[rowNumber]
+ mu.hat <- as.vector(sf * exp(x %*% beta))
+ minmu <- 0.1
+ mu.hat[mu.hat < minmu] <- minmu
+ w <- diag(1/(1/mu.hat^2 * ( mu.hat + alpha * mu.hat^2 )))
+ betaPriorVar <- attr(object,"betaPriorVar")
+ ridge <- diag(1/(log(2)^2 * betaPriorVar))
+ sigma <- solve(t(x) %*% w %*% x + ridge) %*% (t(x) %*% w %*% x) %*% t(solve(t(x) %*% w %*% x + ridge))
+ # convert back to log2 scale
+ sigmaLog2Scale <- log2(exp(1))^2 * sigma
+ sigmaLog2Scale
+}
+
+getDesignFactors <- function(object) {
+ design <- design(object)
+ designVars <- all.vars(design)
+ designVarsClass <- sapply(designVars, function(v) class(colData(object)[[v]]))
+ designVars[designVarsClass == "factor"]
+}
+
+# looking at the values of x which are large
+# in absolute value, find the zero-centered Normal distribution
+# with the matching quantile, and return the variance
+# of that Normal distribution
+matchUpperQuantileForVariance <- function(x, upperQuantile=.05) {
+ sdEst <- quantile(abs(x), 1 - upperQuantile) / qnorm(1 - upperQuantile/2)
+ unname(sdEst)^2
+}
+
+matchWeightedUpperQuantileForVariance <- function(x, weights, upperQuantile=.05) {
+ sdEst <- wtd.quantile(abs(x), weights=weights, 1 - upperQuantile, normwt=TRUE) / qnorm(1 - upperQuantile/2)
+ unname(sdEst)^2
+}
+
+
+
+
+
+# this function calls fitNbinomGLMs() twice:
+# 1 - without the beta prior, in order to calculate the
+# beta prior variance and hat matrix
+# 2 - again but with the prior in order to get beta matrix and standard errors
+fitGLMsWithPrior <- function(object, maxit, useOptim, useQR, betaPriorVar) {
+
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+ modelMatrixType <- attr(object, "modelMatrixType")
+
+ if (missing(betaPriorVar) | !("H" %in% assayNames(objectNZ))) {
+ # first, fit the negative binomial GLM without a prior,
+ # used to construct the prior variances
+ # and for the hat matrix diagonals for calculating Cook's distance
+ fit <- fitNbinomGLMs(objectNZ, maxit=maxit, useOptim=useOptim, useQR=useQR,
+ renameCols = (modelMatrixType == "standard"))
+ modelMatrix <- fit$modelMatrix
+ modelMatrixNames <- colnames(modelMatrix)
+ H <- fit$hat_diagonal
+ betaMatrix <- fit$betaMatrix
+
+ modelMatrixNames[modelMatrixNames == "(Intercept)"] <- "Intercept"
+ modelMatrixNames <- make.names(modelMatrixNames)
+ colnames(betaMatrix) <- modelMatrixNames
+
+ # save the MLE log fold changes for addMLE argument of results
+ convertNames <- renameModelMatrixColumns(colData(object),
+ design(objectNZ))
+ convertNames <- convertNames[convertNames$from %in% modelMatrixNames,,drop=FALSE]
+ modelMatrixNames[match(convertNames$from, modelMatrixNames)] <- convertNames$to
+ mleBetaMatrix <- fit$betaMatrix
+ colnames(mleBetaMatrix) <- paste0("MLE_",modelMatrixNames)
+
+ # store for use in estimateBetaPriorVar below
+ mcols(objectNZ) <- cbind(mcols(objectNZ), DataFrame(mleBetaMatrix))
+ } else {
+ # we can skip the first MLE fit because the
+ # beta prior variance and hat matrix diagonals were provided
+ modelMatrix <- model.matrix(design(objectNZ), colData(object))
+ H <- assays(objectNZ)[["H"]]
+ mleBetaMatrix <- as.matrix(mcols(objectNZ)[,grep("MLE_",names(mcols(objectNZ))),drop=FALSE])
+ }
+
+ if (missing(betaPriorVar)) {
+ betaPriorVar <- estimateBetaPriorVar(objectNZ)
+ } else {
+ # else we are provided the prior variance:
+ # check if the lambda is the correct length
+ # given the design formula
+ if (modelMatrixType == "expanded") {
+ modelMatrix <- makeExpandedModelMatrix(objectNZ)
+ }
+ p <- ncol(modelMatrix)
+ if (length(betaPriorVar) != p) {
+ stop(paste("betaPriorVar should have length",p,"to match:",paste(colnames(modelMatrix),collapse=", ")))
+ }
+ }
+
+ # refit the negative binomial GLM with a prior on betas
+ if (any(betaPriorVar == 0)) {
+ stop("beta prior variances are equal to zero for some variables")
+ }
+ lambda <- 1/betaPriorVar
+
+ if (modelMatrixType == "standard") {
+ fit <- fitNbinomGLMs(objectNZ, lambda=lambda, maxit=maxit, useOptim=useOptim,
+ useQR=useQR)
+ modelMatrix <- fit$modelMatrix
+ } else {
+ modelMatrix <- makeExpandedModelMatrix(objectNZ)
+ fit <- fitNbinomGLMs(objectNZ, lambda=lambda, maxit=maxit, useOptim=useOptim,
+ useQR=useQR, modelMatrix=modelMatrix, renameCols=FALSE)
+ }
+
+ res <- list(fit=fit, H=H, betaPriorVar=betaPriorVar,
+ modelMatrix=modelMatrix, mleBetaMatrix=mleBetaMatrix)
+ res
+}
+
+
+# breaking out the optim backup code from fitNbinomGLMs
+fitNbinomGLMsOptim <- function(object,modelMatrix,lambda,
+ rowsForOptim,rowStable,
+ normalizationFactors,alpha_hat,
+ betaMatrix,betaSE,betaConv,
+ beta_mat,
+ mu,logLike) {
+ scaleCols <- apply(modelMatrix,2,function(z) max(abs(z)))
+ stopifnot(all(scaleCols > 0))
+ x <- sweep(modelMatrix,2,scaleCols,"/")
+ lambdaColScale <- lambda / scaleCols^2
+ lambdaColScale <- ifelse(lambdaColScale == 0, 1e-6, lambdaColScale)
+ lambdaLogScale <- lambda / log(2)^2
+ lambdaLogScaleColScale <- lambdaLogScale / scaleCols^2
+ large <- 30
+ for (row in rowsForOptim) {
+ betaRow <- if (rowStable[row] & all(abs(betaMatrix[row,]) < large)) {
+ betaMatrix[row,] * scaleCols
+ } else {
+ beta_mat[row,] * scaleCols
+ }
+ nf <- normalizationFactors[row,]
+ k <- counts(object)[row,]
+ alpha <- alpha_hat[row]
+ objectiveFn <- function(p) {
+ mu_row <- as.numeric(nf * 2^(x %*% p))
+ logLike <- sum(dnbinom(k,mu=mu_row,size=1/alpha,log=TRUE))
+ logPrior <- sum(dnorm(p,0,sqrt(1/lambdaColScale),log=TRUE))
+ negLogPost <- -1 * (logLike + logPrior)
+ if (is.finite(negLogPost)) negLogPost else 10^300
+ }
+ o <- optim(betaRow, objectiveFn, method="L-BFGS-B",lower=-large, upper=large)
+ ridge <- if (length(lambdaLogScale) > 1) {
+ diag(lambdaLogScaleColScale)
+ } else {
+ as.matrix(lambdaLogScaleColScale,ncol=1)
+ }
+ # if we converged, change betaConv to TRUE
+ if (o$convergence == 0) {
+ betaConv[row] <- TRUE
+ }
+ # with or without convergence, store the estimate from optim
+ betaMatrix[row,] <- o$par / scaleCols
+ # calculate the standard errors
+ mu_row <- as.numeric(nf * 2^(x %*% o$par))
+ minmu <- 0.1
+ mu_row[mu_row < minmu] <- minmu
+ w <- diag((mu_row^-1 + alpha)^-1)
+ xtwx <- t(x) %*% w %*% x
+ xtwxRidgeInv <- solve(xtwx + ridge)
+ sigma <- xtwxRidgeInv %*% xtwx %*% xtwxRidgeInv
+ # warn below regarding these rows with negative variance
+ betaSE[row,] <- log2(exp(1)) * sqrt(pmax(diag(sigma),0)) / scaleCols
+ # store the new mu vector
+ mu[row,] <- mu_row
+ logLike[row] <- sum(dnbinom(k, mu=mu_row, size=1/alpha, log=TRUE))
+ }
+ return(list(betaMatrix=betaMatrix,betaSE=betaSE,
+ betaConv=betaConv,
+ mu=mu,logLike=logLike))
+}
+
+
+### DEPRECATED ###
+# backup function in case dispersion doesn't converge
+# this functionality is now implemented in Cpp below
+fitDispInR <- function(y, x, mu, logAlphaPriorMean,
+ logAlphaPriorSigmaSq, usePrior) {
+ disp <- numeric(nrow(y))
+ # function to evaluate posterior
+ logPost <- function(logAlpha) {
+ alpha <- exp(logAlpha)
+ w <- diag(1/(1/murow^2 * ( murow + alpha * murow^2 )))
+ logLike <- sum(dnbinom(yrow, mu=murow, size=1/alpha, log=TRUE))
+ coxReid <- -.5*(log(det(t(x) %*% w %*% x)))
+ logPrior <- if (usePrior) {
+ dnorm(logAlpha, logAlphaPriorMeanRow, sqrt(logAlphaPriorSigmaSq), log=TRUE)
+ } else {
+ 0
+ }
+ (logLike + coxReid + logPrior)
+ }
+
+ maxDisp <- max(10, ncol(y))
+ s <- seq(from=log(1e-8),to=log(maxDisp),length=15)
+ delta <- s[2] - s[1]
+ # loop through rows
+ for (i in seq_len(nrow(y))) {
+ murow <- mu[i,]
+ yrow <- y[i,]
+ logAlphaPriorMeanRow <- logAlphaPriorMean[i]
+ lpo <- sapply(s, logPost)
+ sfine <- seq(from=s[which.max(lpo)]-delta, to=s[which.max(lpo)]+delta, length=15)
+ lpofine <- sapply(sfine, logPost)
+ disp[i] <- exp(sfine[which.max(lpofine)])
+ }
+ disp
+}
+
+# Fit dispersions by evaluating over grid
+#
+# This function estimates the dispersion parameter (alpha) for negative binomial
+# generalized linear models. The fitting is performed on the log scale.
+#
+# ySEXP n by m matrix of counts
+# xSEXP m by k design matrix
+# mu_hatSEXP n by m matrix, the expected mean values, given beta-hat
+# disp_gridSEXP the grid over which to estimate
+# log_alpha_prior_meanSEXP n length vector of the fitted values for log(alpha)
+# log_alpha_prior_sigmasqSEXP a single numeric value for the variance of the prior
+# use_priorSEXP boolean variable, whether to use a prior or just calculate the MLE
+#
+# return a list with elements:
+fitDispGridWrapper <- function(y, x, mu, logAlphaPriorMean,
+ logAlphaPriorSigmaSq, usePrior) {
+ # test for any NAs in arguments
+ arg.names <- names(formals(fitDispGridWrapper))
+ na.test <- sapply(mget(arg.names), function(x) any(is.na(x)))
+ if (any(na.test)) stop(paste("in call to fitDispGridWrapper, the following arguments contain NA:",
+ paste(arg.names[na.test],collapse=", ")))
+ minLogAlpha <- log(1e-8)
+ maxLogAlpha <- log(max(10, ncol(y)))
+ dispGrid <- seq(from=minLogAlpha, to=maxLogAlpha, length=15)
+ logAlpha <- fitDispGrid(ySEXP=y, xSEXP=x, mu_hatSEXP=mu, disp_gridSEXP=dispGrid,
+ log_alpha_prior_meanSEXP=logAlphaPriorMean,
+ log_alpha_prior_sigmasqSEXP=logAlphaPriorSigmaSq,
+ use_priorSEXP=usePrior)$log_alpha
+ exp(logAlpha)
+}
+
+
+
+# rough dispersion estimate using counts and fitted values
+roughDispEstimate <- function(y, x) {
+
+ # must be positive
+ mu <- linearModelMu(y, x)
+ mu <- matrix(pmax(1, mu), ncol=ncol(mu))
+
+ m <- nrow(x)
+ p <- ncol(x)
+
+ # an alternate rough estimator with higher mean squared or absolute error
+ # (rowSums( (y - mu)^2/(mu * (m - p)) ) - 1)/rowMeans(mu)
+
+ # rough disp ests will be adjusted up to minDisp later
+ est <- rowSums( ((y - mu)^2 - mu) / mu^2 ) / (m - p)
+ pmax(est, 0)
+}
+
+momentsDispEstimate <- function(object) {
+ xim <- if (!is.null(normalizationFactors(object))) {
+ mean(1/colMeans(normalizationFactors(object)))
+ } else {
+ mean(1/sizeFactors(object))
+ }
+ bv <- mcols(object)$baseVar
+ bm <- mcols(object)$baseMean
+ (bv - xim*bm)/bm^2
+}
+
+# fast, rough estimation of means for rough dispersion estimation (above)
+linearModelMu <- function(y, x) {
+ qrx <- qr(x)
+ Q <- qr.Q(qrx)
+ Rinv <- solve(qr.R(qrx))
+ hatmatrix <- x %*% Rinv %*% t(Q)
+ t(hatmatrix %*% t(y))
+}
+
+# checks for LRT formulas, written as function to remove duplicate code
+# in DESeq() and nbinomLRT()
+checkLRT <- function(full, reduced) {
+ reducedNotInFull <- !all.vars(reduced) %in% all.vars(full)
+ if (any(reducedNotInFull)) {
+ stop(paste("the following variables in the reduced formula not in the full formula:",
+ paste(all.vars(reduced)[reducedNotInFull],collapse=", ")))
+ }
+}
+
+# bulky code separated from DESeq()
+refitWithoutOutliers <- function(object, test, betaPrior, full, reduced,
+ quiet, minReplicatesForReplace, modelMatrix, modelMatrixType) {
+ cooks <- assays(object)[["cooks"]]
+ object <- replaceOutliers(object, minReplicates=minReplicatesForReplace)
+
+ # refit without outliers, if there were any replacements
+ nrefit <- sum(mcols(object)$replace, na.rm=TRUE)
+ if ( nrefit > 0 ) {
+ object <- getBaseMeansAndVariances(object)
+ newAllZero <- which(mcols(object)$replace & mcols(object)$allZero)
+ }
+ # only refit if some of the replacements don't result in all zero counts
+ # otherwise, these cases are handled by results()
+ if ( nrefit > 0 && nrefit > length(newAllZero) ) {
+ if (!quiet) message(paste("-- replacing outliers and refitting for", nrefit,"genes
+-- DESeq argument 'minReplicatesForReplace' =",minReplicatesForReplace,"
+-- original counts are preserved in counts(dds)"))
+
+ # refit on those rows which had replacement
+ refitReplace <- which(mcols(object)$replace & !mcols(object)$allZero)
+ objectSub <- object[refitReplace,]
+ intermediateOrResults <- which(mcols(mcols(objectSub))$type %in% c("intermediate","results"))
+ mcols(objectSub) <- mcols(objectSub)[,-intermediateOrResults,drop=FALSE]
+
+ # estimate gene-wise dispersion
+ if (!quiet) message("estimating dispersions")
+ objectSub <- estimateDispersionsGeneEst(objectSub, quiet=quiet, modelMatrix=modelMatrix)
+
+ # need to redo fitted dispersion due to changes in base mean
+ mcols(objectSub)$dispFit <- dispersionFunction(objectSub)(mcols(objectSub)$baseMean)
+ mcols(mcols(objectSub),use.names=TRUE)["dispFit",] <- DataFrame(type="intermediate",
+ description="fitted values of dispersion")
+ dispPriorVar <- attr( dispersionFunction(object), "dispPriorVar" )
+
+ # estimate dispersion MAP
+ objectSub <- estimateDispersionsMAP(objectSub, quiet=quiet,
+ dispPriorVar=dispPriorVar, modelMatrix=modelMatrix)
+
+ # fit GLM
+ if (!quiet) message("fitting model and testing")
+ if (test == "Wald") {
+ betaPriorVar <- attr(object, "betaPriorVar")
+ objectSub <- nbinomWaldTest(objectSub, betaPrior=betaPrior,
+ betaPriorVar=betaPriorVar, quiet=quiet, modelMatrix=modelMatrix)
+ } else if (test == "LRT") {
+ if (!betaPrior) {
+ objectSub <- nbinomLRT(objectSub, full=full, reduced=reduced, quiet=quiet)
+ } else {
+ betaPriorVar <- attr(object, "betaPriorVar")
+ objectSub <- nbinomLRT(objectSub, full=full, reduced=reduced, betaPrior=betaPrior,
+ betaPriorVar=betaPriorVar, quiet=quiet)
+ }
+ }
+
+ idx <- match(names(mcols(objectSub)), names(mcols(object)))
+ mcols(object)[refitReplace, idx] <- mcols(objectSub)
+ mcols(object)[newAllZero, mcols(mcols(object))$type == "results"] <- NA
+
+ # continue to flag if some conditions have less than minReplicatesForReplace
+ if (all(object$replaceable)) {
+ mcols(object)$maxCooks <- NA
+ } else {
+ replaceCooks <- assays(object)[["cooks"]]
+ replaceCooks[,object$replaceable] <- 0
+ mcols(object)$maxCooks <- recordMaxCooks(design(object), colData(object),
+ attr(object,"dispModelMatrix"), replaceCooks, nrow(object))
+ }
+ }
+
+ if ( nrefit > 0 ) {
+ # save the counts used for fitting as replaceCounts
+ assays(object)[["replaceCounts"]] <- counts(object)
+ assays(object)[["replaceCooks"]] <- assays(object)[["cooks"]]
+
+ # preserve original counts and Cook's distances
+ counts(object) <- assays(object)[["originalCounts"]]
+ assays(object)[["cooks"]] <- cooks
+
+ # no longer need this assay slot
+ assays(object)[["originalCounts"]] <- NULL
+ }
+
+ object
+}
+
+sanitizeRowRanges <- function(object) {
+ if (is.null(mcols(mcols(object)))) {
+ mcols(mcols(object)) <- DataFrame(type=rep("input",ncol(mcols(object))),
+ description=character(ncol(mcols(object))))
+ }
+ class(mcols(mcols(object))$type) <- "character"
+ class(mcols(mcols(object))$description) <- "character"
+ mcols(mcols(object))$type[ is.na(mcols(mcols(object))$type) ] <- ""
+ mcols(mcols(object))$description[ is.na(mcols(mcols(object))$description) ] <- ""
+ object
+}
+
+sanitizeColData <- function(object) {
+ if (is.null(mcols(colData(object)))) {
+ mcols(colData(object)) <- DataFrame(type=rep("input",ncol(colData(object))),
+ description=character(ncol(colData(object))))
+ }
+ class(mcols(colData(object))$type) <- "character"
+ class(mcols(colData(object))$description) <- "character"
+ mcols(colData(object))$type[ is.na(mcols(colData(object))$type) ] <- ""
+ mcols(colData(object))$description[ is.na(mcols(colData(object))$description) ] <- ""
+ object
+}
+
+estimateSizeFactorsIterate <- function(object, niter=10, Q=0.05) {
+ design(object) <- ~ 1
+ sf <- rep(1, ncol(object))
+ idx <- rowSums(counts(object)) > 0
+ cts <- counts(object)[idx,]
+ for (i in seq_len(niter)) {
+ sizeFactors(object) <- sf
+ object <- estimateDispersions(object, fitType="mean", quiet=TRUE)
+ q <- t(t(assays(object)[["mu"]])/sf)[idx,]
+ disps <- dispersions(object)[idx]
+ sf.old <- sf
+ fn <- function(p) {
+ sf <- exp(p - mean(p))
+ mu.new <- t(t(q) * sf)
+ ll <- matrix(dnbinom(cts, mu=mu.new, size=1/disps, log=TRUE), ncol=ncol(cts))
+ gene.ll <- rowSums(ll)
+ sum(gene.ll[ gene.ll > quantile(gene.ll, Q) ])
+ }
+ res <- optim(log(sf.old), fn, control=list(fnscale=-1), method="L-BFGS-B")
+ if (res$convergence != 0) {
+ stop("iterative size factor normalization did not converge within an iteration")
+ }
+ sf <- exp(res$par - mean(res$par))
+ # loop more than once, and test for convergence
+ if (i > 1 & sum((log(sf.old) - log(sf))^2) < 1e-4) {
+ break
+ } else {
+ if (i == niter) {
+ stop("iterative size factor normalization did not converge")
+ }
+ }
+ }
+ sf
+}
+
+checkFullRank <- function(modelMatrix) {
+ if (qr(modelMatrix)$rank < ncol(modelMatrix)) {
+ if (any(apply(modelMatrix, 2, function(col) all(col == 0)))) {
+ stop("the model matrix is not full rank, so the model cannot be fit as specified.
+ Levels or combinations of levels without any samples have resulted in
+ column(s) of zeros in the model matrix.
+
+ Please read the vignette section 'Model matrix not full rank':
+
+ vignette('DESeq2')")
+ } else {
+ stop("the model matrix is not full rank, so the model cannot be fit as specified.
+ One or more variables or interaction terms in the design formula are linear
+ combinations of the others and must be removed.
+
+ Please read the vignette section 'Model matrix not full rank':
+
+ vignette('DESeq2')")
+ }
+ }
+}
+
+designAndArgChecker <- function(object, betaPrior) {
+ termsOrder <- attr(terms.formula(design(object)),"order")
+ hasIntercept <- attr(terms(design(object)),"intercept") == 1
+ interactionPresent <- any(termsOrder > 1)
+ if (betaPrior & !hasIntercept) {
+ stop("betaPrior=TRUE can only be used if the design has an intercept.
+ if specifying + 0 in the design formula, use betaPrior=FALSE")
+ }
+ if (betaPrior & interactionPresent) {
+ stop("betaPrior=FALSE should be used for designs with interactions")
+ }
+
+ design <- design(object)
+ designVars <- all.vars(design)
+ if (length(designVars) > 0) {
+ if (any(sapply(designVars, function(v) any(is.na(colData(object)[[v]]))))) {
+ stop("variables in the design formula cannot have NA values")
+ }
+ designFactors <- designVars[sapply(designVars, function(v) is(colData(object)[[v]], "factor"))]
+ if (length(designFactors) > 0 && any(sapply(designFactors,function(v) any(table(colData(object)[[v]]) == 0)))) {
+ stop("factors in design formula must have samples for each level.
+ this error can arise when subsetting a DESeqDataSet, in which
+ all the samples for one or more levels of a factor in the design were removed.
+ if this was intentional, use droplevels() to remove these levels, e.g.:
+
+ dds$condition <- droplevels(dds$condition)
+")
+ }
+ if (any(sapply(designVars, function(v) is(colData(object)[[v]], "ordered")))) {
+ stop("the design contains an ordered factor. The internal steps
+that estimate the beta prior variance and produce resultsNames
+do not work on ordered factors. You should instead use model.matrix()
+and then provide your custom matrix to 'full' argument of DESeq().
+(You should also provide a matrix to 'reduced' for test='LRT'.)")
+ }
+ }
+}
+
diff --git a/R/expanded.R b/R/expanded.R
new file mode 100644
index 0000000..d5248d0
--- /dev/null
+++ b/R/expanded.R
@@ -0,0 +1,100 @@
+makeExpandedModelMatrix <- function(object) {
+ designFactors <- getDesignFactors(object)
+ coldata <- colData(object)
+ coldata <- rbind(coldata,coldata[nrow(coldata),,drop=FALSE])
+ for (f in designFactors) {
+ levels(coldata[[f]]) <- c(levels(coldata[[f]]),"_null_level_")
+ coldata[[f]] <- relevel(coldata[[f]],"_null_level_")
+ coldata[[f]][nrow(coldata)] <- "_null_level_"
+ }
+ mm0 <- model.matrix(design(object), data=coldata)
+ # these can appear when interactions are present without main effect variables
+ nullLvls <- grepl("_null_level_",colnames(mm0))
+ mm <- mm0[-nrow(mm0),!nullLvls,drop=FALSE]
+ attr(mm,"assign") <- attr(mm0,"assign")
+ colnames(mm)[colnames(mm) == "(Intercept)"] <- "Intercept"
+ colnames(mm) <- make.names(colnames(mm))
+ mm
+}
+
+averagePriorsOverLevels <- function(object, betaPriorVar) {
+ expandedModelMatrix <- makeExpandedModelMatrix(object)
+ expandedNames <- colnames(expandedModelMatrix)
+ betaPriorIn <- betaPriorVar
+ betaPriorOut <- numeric(length(expandedNames))
+ names(betaPriorOut) <- expandedNames
+ bpiNms <- names(betaPriorIn)
+ idx <- which(bpiNms %in% expandedNames)
+ betaPriorOut[match(bpiNms[idx],expandedNames)] <- betaPriorIn[idx]
+ designFactors <- getDesignFactors(object)
+ allVars <- all.vars(design(object))
+ coldata <- colData(object)
+ for (f in designFactors) {
+ lvls <- levels(coldata[[f]])
+ mmColnames <- make.names(paste0(f,c(lvls,"Cntrst")))
+ meanPriorVar <- mean(betaPriorIn[names(betaPriorIn) %in% mmColnames])
+ betaPriorOut[expandedNames %in% mmColnames] <- meanPriorVar
+ }
+
+ # pre-v1.10 code regarding interactions and the beta prior:
+ # ------------------------------------------------------------
+ # also set prior for any interactions between design factors
+ # which are new in the expanded model matrix using existing interactions
+ ## termsOrder <- attr(terms.formula(design(object)),"order")
+ ## if (any(termsOrder > 1)) {
+ ## for (f1 in designFactors) {
+ ## for (f2 in allVars) {
+ ## if (f1 == f2) next
+ ## lvls1 <- levels(coldata[[f1]])
+ ## # the case where f2 is a factor like f1
+ ## if (f2 %in% designFactors) {
+ ## lvls2 <- levels(coldata[[f2]])
+ ## mmColnames <- make.names(paste0(f1,rep(lvls1,each=length(lvls2)),":",
+ ## f2,rep(lvls2,times=length(lvls1))))
+ ## meanPriorVar <- mean(betaPriorIn[names(betaPriorIn) %in% mmColnames])
+ ## betaPriorOut[expandedNames %in% mmColnames] <- meanPriorVar
+ ## # the case where f2 is not a factor
+ ## } else {
+ ## mmColnames <- make.names(c(paste0(f1,lvls1,":",f2),paste0(f2,":",f1,lvls1)))
+ ## meanPriorVar <- mean(betaPriorIn[names(betaPriorIn) %in% mmColnames])
+ ## betaPriorOut[expandedNames %in% mmColnames] <- meanPriorVar
+ ## }
+ ## }
+ ## }
+ ## }
+
+ if (any(is.na(betaPriorOut))) {
+ stop(paste("beta prior for",paste(names(betaPriorOut)[is.na(betaPriorOut)],collapse=","),"is NA"))
+ }
+ if (!all(betaPriorOut > 0)) {
+ stop(paste("beta prior for",paste(names(betaPriorOut)[betaPriorOut <= 0],collapse=","),"is not greater than 0"))
+ }
+ betaPriorOut
+}
+
+# adds all first order contrasts
+addAllContrasts <- function(object, betaMatrix) {
+ designFactors <- getDesignFactors(object)
+ coldata <- colData(object)
+ for (f in designFactors) {
+ lvls <- levels(coldata[[f]])
+ mmColnames <- make.names(paste0(f,lvls))
+ M <- betaMatrix[,colnames(betaMatrix) %in% mmColnames,drop=FALSE]
+ n <- ncol(M)
+ if (n > 1) {
+ if (n == 2) {
+ is <- 2
+ js <- 1
+ } else {
+ is <- do.call(c,sapply(seq_len(n-1)+1, function(k) seq(from=k,to=n)))
+ js <- rep(seq_len(n-1),rev(seq_len(n-1)))
+ }
+ contrastCols <- mapply(function(i,j) M[,i] - M[,j], i=is, j=js)
+ colnames(contrastCols) <- rep(make.names(paste0(f,"Cntrst")),ncol(contrastCols))
+ betaMatrix <- cbind(betaMatrix, contrastCols)
+ }
+ }
+ betaMatrix
+}
+
+
diff --git a/R/helper.R b/R/helper.R
new file mode 100644
index 0000000..af0be0b
--- /dev/null
+++ b/R/helper.R
@@ -0,0 +1,535 @@
+#' Collapse technical replicates in a RangedSummarizedExperiment or DESeqDataSet
+#'
+#' Collapses the columns in \code{object} by summing within levels
+#' of a grouping factor \code{groupby}. The purpose of this function
+#' is to sum up read counts from technical replicates to create an object
+#' with a single column of read counts for each sample.
+#' Optionally renames the columns of returned object with the levels of the
+#' grouping factor.
+#' Note: this function is written very simply and
+#' can be easily altered to produce other behavior by examining the source code.
+#'
+#' @param object A \code{RangedSummarizedExperiment} or \code{DESeqDataSet}
+#' @param groupby a grouping factor, as long as the columns of object
+#' @param run optional, the names of each unique column in object. if provided,
+#' a new column \code{runsCollapsed} will be added to the \code{colData}
+#' which pastes together the names of \code{run}
+#' @param renameCols whether to rename the columns of the returned object
+#' using the levels of the grouping factor
+#'
+#' @return the \code{object} with as many columns as levels in \code{groupby}.
+#' This object has assay/count data which is summed from the various
+#' columns which are grouped together, and the \code{colData} is subset using
+#' the first column for each group in \code{groupby}.
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=12)
+#'
+#' # make data with two technical replicates for three samples
+#' dds$sample <- factor(sample(paste0("sample",rep(1:9, c(2,1,1,2,1,1,2,1,1)))))
+#' dds$run <- paste0("run",1:12)
+#'
+#' ddsColl <- collapseReplicates(dds, dds$sample, dds$run)
+#'
+#' # examine the colData and column names of the collapsed data
+#' colData(ddsColl)
+#' colnames(ddsColl)
+#'
+#' # check that the sum of the counts for "sample1" is the same
+#' # as the counts in the "sample1" column in ddsColl
+#' matchFirstLevel <- dds$sample == levels(dds$sample)[1]
+#' stopifnot(all(rowSums(counts(dds[,matchFirstLevel])) == counts(ddsColl[,1])))
+#'
+#' @export
+collapseReplicates <- function(object, groupby, run, renameCols=TRUE) {
+ if (!is.factor(groupby)) groupby <- factor(groupby)
+ groupby <- droplevels(groupby)
+ stopifnot(length(groupby) == ncol(object))
+ sp <- split(seq(along=groupby), groupby)
+ countdata <- sapply(sp, function(i) rowSums(assay(object)[,i,drop=FALSE]))
+ mode(countdata) <- "integer"
+ colsToKeep <- sapply(sp, `[`, 1)
+ collapsed <- object[,colsToKeep]
+ dimnames(countdata) <- dimnames(collapsed)
+ assay(collapsed) <- countdata
+ if (!missing(run)) {
+ stopifnot(length(groupby) == length(run))
+ colData(collapsed)$runsCollapsed <- sapply(sp, function(i) paste(run[i],collapse=","))
+ }
+ if (renameCols) {
+ colnames(collapsed) <- levels(groupby)
+ }
+ stopifnot(sum(as.numeric(assay(object))) == sum(as.numeric(assay(collapsed))))
+ collapsed
+}
+
+#' FPKM: fragments per kilobase per million mapped fragments
+#'
+#' The following function returns fragment counts normalized
+#' per kilobase of feature length per million mapped fragments
+#' (by default using a robust estimate of the library size,
+#' as in \code{\link{estimateSizeFactors}}).
+#'
+#' The length of the features (e.g. genes) is calculated one of two ways:
+#' if there is a matrix named "avgTxLength" in \code{assays(dds)}, this will take precedence in the
+#' length normalization. Otherwise, feature length is calculated
+#' from the \code{rowRanges} of the dds object,
+#' if a column \code{basepairs} is not present in \code{mcols(dds)}.
+#' The calculated length is the number of basepairs in the union of all \code{GRanges}
+#' assigned to a given row of \code{object}, e.g.,
+#' the union of all basepairs of exons of a given gene.
+#'
+#' Note that, when the read/fragment counting has inter-feature dependencies, a strict
+#' normalization would not incorporate the basepairs of a feature which
+#' overlap another feature. This inter-feature dependence is not taken into
+#' consideration in the internal union basepair calculation.
+#'
+#' @param object a \code{DESeqDataSet}
+#' @param robust whether to use size factors to normalize
+#' rather than taking the column sums of the raw counts,
+#' using the \code{\link{fpm}} function.
+#'
+#' @return a matrix which is normalized per kilobase of the
+#' union of basepairs in the \code{GRangesList} or \code{GRanges}
+#' of the mcols(object), and per million of mapped fragments,
+#' either using the robust median ratio method (robust=TRUE, default)
+#' or using raw counts (robust=FALSE).
+#' Defining a column \code{mcols(object)$basepairs} takes
+#' precedence over internal calculation of the kilobases for each row.
+#'
+#' @examples
+#'
+#' # create a matrix with 1 million counts for the
+#' # 2nd and 3rd column, the 1st and 4th have
+#' # half and double the counts, respectively.
+#' m <- matrix(1e6 * rep(c(.125, .25, .25, .5), each=4),
+#' ncol=4, dimnames=list(1:4,1:4))
+#' mode(m) <- "integer"
+#' se <- SummarizedExperiment(list(counts=m), colData=DataFrame(sample=1:4))
+#' dds <- DESeqDataSet(se, ~ 1)
+#'
+#' # create 4 GRanges with lengths: 1, 1, 2, 2.5 Kb
+#' gr1 <- GRanges("chr1",IRanges(1,1000)) # 1kb
+#' gr2 <- GRanges("chr1",IRanges(c(1,1001),c( 500,1500))) # 1kb
+#' gr3 <- GRanges("chr1",IRanges(c(1,1001),c(1000,2000))) # 2kb
+#' gr4 <- GRanges("chr1",IRanges(c(1,1001),c(200,1300))) # 500bp
+#' rowRanges(dds) <- GRangesList(gr1,gr2,gr3,gr4)
+#'
+#' # the raw counts
+#' counts(dds)
+#'
+#' # the FPM values
+#' fpm(dds)
+#'
+#' # the FPKM values
+#' fpkm(dds)
+#'
+#' @seealso \code{\link{fpm}}
+#'
+#' @docType methods
+#' @name fpkm
+#' @rdname fpkm
+#'
+#' @export
+fpkm <- function(object, robust=TRUE) {
+ fpm <- fpm(object, robust=robust)
+ if ("avgTxLength" %in% assayNames(object)) {
+ return(1e3 * fpm / assays(object)[["avgTxLength"]])
+ }
+ if (is.null(mcols(object)$basepairs)) {
+ if (class(rowRanges(object)) == "GRangesList") {
+ ubp <- DataFrame(basepairs = sum(width(reduce(rowRanges(object)))))
+ } else if (class(rowRanges(object)) == "GRanges") {
+ ubp <- DataFrame(basepairs = width(rowRanges(object)))
+ }
+ if (all(ubp$basepairs == 0)) {
+ stop("rowRanges(object) has all ranges of zero width.
+the user should instead supply a column, mcols(object)$basepairs,
+which will be used to produce FPKM values")
+ }
+ if (is.null(mcols(mcols(object)))) {
+ mcols(object) <- ubp
+ } else {
+ mcols(ubp) <- DataFrame(type="intermediate",
+ description="count of basepairs in the union of all ranges")
+ mcols(object) <- cbind(mcols(object), ubp)
+ }
+ }
+ 1e3 * sweep(fpm, 1, mcols(object)$basepairs, "/")
+}
+
+#' FPM: fragments per million mapped fragments
+#'
+#' Calculates either a robust version (default)
+#' or the traditional matrix of fragments/counts per million mapped
+#' fragments (FPM/CPM).
+#' Note: this function is written very simply and
+#' can be easily altered to produce other behavior by examining the source code.
+#'
+#' @param object a \code{DESeqDataSet}
+#' @param robust whether to use size factors to normalize
+#' rather than taking the column sums of the raw counts.
+#' If TRUE, the size factors and the geometric mean of
+#' column sums are multiplied to create a robust library size estimate.
+#'
+#' @return a matrix which is normalized per million of mapped fragments,
+#' either using the robust median ratio method (robust=TRUE, default)
+#' or using raw counts (robust=FALSE).
+#'
+#' @examples
+#'
+#' # generate a dataset with size factors: .5, 1, 1, 2
+#' dds <- makeExampleDESeqDataSet(m = 4, n = 1000,
+#' interceptMean=log2(1e3),
+#' interceptSD=0,
+#' sizeFactors=c(.5,1,1,2),
+#' dispMeanRel=function(x) .01)
+#'
+#' # add a few rows with very high count
+#' counts(dds)[4:10,] <- 2e5L
+#'
+#' # in this robust version, the counts are comparable across samples
+#' round(head(fpm(dds), 3))
+#'
+#' # in this column sum version, the counts are still skewed:
+#' # sample1 < sample2 & 3 < sample 4
+#' round(head(fpm(dds, robust=FALSE), 3))
+#'
+#' # the column sums of the robust version
+#' # are not equal to 1e6, but the
+#' # column sums of the non-robust version
+#' # are equal to 1e6 by definition
+#'
+#' colSums(fpm(dds))/1e6
+#' colSums(fpm(dds, robust=FALSE))/1e6
+#'
+#' @seealso \code{\link{fpkm}}
+#'
+#' @docType methods
+#' @name fpm
+#' @rdname fpm
+#'
+#' @export
+fpm <- function(object, robust=TRUE) {
+ if (robust & is.null(sizeFactors(object))) {
+ object <- estimateSizeFactors(object)
+ }
+ k <- counts(object)
+ library.sizes <- if (robust) {
+ sizeFactors(object) * exp(mean(log(colSums(k))))
+ } else {
+ colSums(k)
+ }
+ 1e6 * sweep(k, 2, library.sizes, "/")
+}
+
+
+
+#' Normalize for gene length
+#'
+#' Normalize for gene length using the output of transcript abundance estimators
+#'
+#' This is a prototype function for importing information about changes in
+#' the average transcript length for each gene. The use of this function
+#' is only for testing purposes.
+#'
+#' The function simply imports or calculates average
+#' transcript length for each gene and each sample from external files,
+#' and provides this matrix to the \code{normMatrix} argument of
+#' \code{\link{estimateSizeFactors}}.
+#' By average transcript length, the average refers to a weighted average with respect
+#' to the transcript abundances. The RSEM method includes such a column in their
+#' \code{gene.results} files, but an estimate of average transcript length can
+#' be obtained from any software which outputs a file with a row for each
+#' transcript, specifying: transcript length, estimate of transcript abundance,
+#' and the gene which the transcript belongs to.
+#'
+#' Normalization factors accounting for both average transcript length and
+#' library size of each sample are generated and then stored within the data object.
+#' The analysis can then continue with \code{\link{DESeq}};
+#' the stored normalization factors will be used instead of size factors in the analysis.
+#'
+#' For RSEM \code{genes.results} files,
+#' specify \code{level="gene"}, \code{geneIdCol="gene_id"},
+#' and \code{lengthCol="effective_length"}
+#'
+#' For Cufflinks \code{isoforms.fpkm_tracking} files,
+#' specify \code{level="tx"}, \code{geneIdCol="gene_id"},
+#' \code{lengthCol="length"}, and \code{abundanceCol="FPKM"}.
+#'
+#' For Sailfish output files, one can write an \code{importer}
+#' function which attaches a column \code{gene_id} based on Transcript ID,
+#' and then specify \code{level="tx"}, \code{geneIdCol="gene_id"},
+#' \code{lengthCol="Length"} and \code{abundanceCol="RPKM"}.
+#'
+#' Along with the normalization matrix which is stored in \code{normalizationFactors(object)},
+#' the resulting gene length matrix is stored in \code{assays(dds)[["avgTxLength"]]},
+#' and will take precedence in calls to \code{\link{fpkm}}.
+#'
+#' @param object the DESeqDataSet, before calling \code{DESeq}
+#' @param files a character vector specifying the filenames of output files
+#' containing either transcript abundance estimates with transcript length,
+#' or average transcript length information per gene.
+#' @param level either "tx" or "gene"
+#' @param geneIdCol the name of the column of the files specifying the gene id. This
+#' should line up with the \code{rownames(object)}. The information in the files
+#' will be re-ordered to line up with the rownames of the object.
+#' See \code{dropGenes} for more details.
+#' @param lengthCol the name of the column of files specifying the length of the
+#' feature, either transcript for \code{level="tx"} or the gene for
+#' \code{level="gene"}.
+#' @param abundanceCol only needed if \code{level="tx"}, the name of the
+#' column specifying the abundance estimate of the transcript.
+#' @param dropGenes whether to drop genes from the object,
+#' as labelled by \code{rownames(object)}, which are not
+#' present in the \code{geneIdCol} of the files. Defaults to FALSE
+#' and gives an error upon finding \code{rownames} of the object
+#' not present in the \code{geneIdCol} of the files.
+#' The function will reorder the matching rows of the files to match
+#' the rownames of the object.
+#' @param importer a function to read the \code{files}.
+#' \code{fread} from the data.table package is quite fast,
+#' but other options include \code{read.table}, \code{read.csv}.
+#' One can pre-test with \code{importer(files[1])}.
+#' @param ... further arguments passed to \code{importer}
+#'
+#' @return a DESeqDataSet with \code{\link{normalizationFactors}}
+#' accounting for average transcript length and library size
+#'
+#' @examples
+#'
+#' n <- 10
+#' files <- c("sample1","sample2")
+#' gene_id <- rep(paste0("gene",seq_len(n)),each=3)
+#' set.seed(1)
+#' sample1 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+#' sample2 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+#' importer <- get
+#' dds <- makeExampleDESeqDataSet(n=n, m=2)
+#' dds <- normalizeGeneLength(dds, files=files, level="tx",
+#' geneIdCol="gene_id", lengthCol="length", abundanceCol="FPKM",
+#' dropGenes=TRUE, importer=importer)
+#'
+#' @export
+normalizeGeneLength <- function(object, files, level=c("tx","gene"),
+ geneIdCol="gene_id", lengthCol="length", abundanceCol="FPKM",
+ dropGenes=FALSE, importer, ...) {
+ stopifnot(length(files) == ncol(object))
+ message("assuming: 'files' and colnames of the dds in same order:
+ files: ",paste(head(files,4),collapse=", "),"...
+ colnames: ",paste(head(colnames(object),4),collapse=", "),"...")
+ dataList <- list()
+ level <- match.arg(level, c("tx","gene"))
+ for (i in seq_along(files)) {
+ raw <- as.data.frame(importer(files[i], ...))
+ if (level == "tx") {
+ stopifnot(all(c(geneIdCol, lengthCol, abundanceCol) %in% names(raw)))
+ raw[[geneIdCol]] <- factor(raw[[geneIdCol]], unique(raw[[geneIdCol]]))
+ res <- do.call(c, as.list(by(raw, raw[[geneIdCol]],
+ function(x) sum(x[[lengthCol]] * x[[abundanceCol]])/sum(x[[abundanceCol]]),
+ simplify=FALSE)))
+ dataList[[i]] <- data.frame(avgLength=res, row.names=names(res))
+ } else if (level == "gene") {
+ stopifnot(all(c(geneIdCol, lengthCol) %in% names(raw)))
+ dataList[[i]] <- data.frame(avgLength=raw[[lengthCol]], row.names=raw[[geneIdCol]])
+ }
+ }
+ for (i in seq_along(files)[-1]) {
+ stopifnot(all(rownames(dataList[[i]]) == rownames(dataList[[1]])))
+ }
+ data <- do.call(cbind, dataList)
+ data <- as.matrix(data)
+
+ common <- rownames(object)[rownames(object) %in% rownames(data)]
+ if (length(common) < nrow(object)) {
+ message(length(common)," genes out of ",nrow(object)," of the dds object are present in the gene length data")
+ if (dropGenes) {
+ message("dropping genes from the dds")
+ object <- object[common,]
+ } else {
+ stop("specify 'dropGenes=TRUE' in order to drop genes from the dds")
+ }
+ }
+ if (!all(rownames(data) == rownames(object))) {
+ data <- data[match(common, rownames(data)),]
+ }
+ stopifnot(rownames(data) == rownames(object))
+ message("adding normalization factors for gene length")
+ object <- estimateSizeFactors(object, normMatrix=data)
+ message("users can continue with DESeq()")
+ dimnames(data) <- dimnames(object)
+ assays(object)[["avgTxLength"]] <- data
+ object
+}
+
+#' Normalized counts transformation
+#'
+#' A simple function for creating a \code{\link{DESeqTransform}}
+#' object after applying: f(count + pc).
+#'
+#' @param object a DESeqDataSet object
+#' @param f a function to apply to normalized counts
+#' @param pc a pseudocount to add to normalized counts
+#'
+#' @seealso \code{\link{varianceStabilizingTransformation}}, \code{\link{rlog}}
+#'
+#' @export
+normTransform <- function(object, f=log2, pc=1) {
+ if (is.null(sizeFactors(object)) & is.null(normalizationFactors(object))) {
+ object <- estimateSizeFactors(object)
+ }
+ nt <- f(counts(object, normalized=TRUE) + pc)
+ se <- SummarizedExperiment(
+ assays = nt,
+ colData = colData(object),
+ rowRanges = rowRanges(object),
+ metadata = metadata(object))
+ DESeqTransform(se)
+}
+
+
+#####################
+# unexported
+#####################
+
+
+
+
+
+
+
+
+
+# function to split up DESeqDataSet by rows during easily parallelizable steps
+
+# TODO: recombining the resulting DESeqDataSets using rbind() is a bit wasteful,
+# as the count matrix and GRanges from the original object are unchanged.
+
+DESeqParallel <- function(object, test, fitType, betaPrior, full, reduced, quiet, modelMatrix, modelMatrixType, BPPARAM) {
+
+ # size factors already estimated or supplied
+ # break up the object into equal sized chunks
+ # to be fed to the different workers
+ object <- getBaseMeansAndVariances(object)
+ objectNZ <- object[!mcols(object)$allZero,,drop=FALSE]
+ nworkers <- BPPARAM$workers
+ idx <- factor(sort(rep(seq_len(nworkers),length=nrow(objectNZ))))
+
+ if (missing(modelMatrixType)) {
+ modelMatrixType <- NULL
+ }
+
+ # if no reps, treat samples as replicates and print warning
+ noReps <- checkForExperimentalReplicates(object, modelMatrix)
+ if (noReps) {
+ designIn <- design(objectNZ)
+ design(objectNZ) <- formula(~ 1)
+ }
+
+ # first parallel execution: gene-wise dispersion estimates
+ if (!quiet) message("estimating dispersions")
+ if (!quiet) message(paste("gene-wise dispersion estimates:",nworkers,"workers"))
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ estimateDispersionsGeneEst(objectNZ[idx == l,,drop=FALSE], quiet=TRUE, modelMatrix=modelMatrix)
+ }, BPPARAM=BPPARAM))
+
+ # the dispersion fit and dispersion prior are estimated over all rows
+ if (!quiet) message("mean-dispersion relationship")
+ objectNZ <- estimateDispersionsFit(objectNZ, fitType=fitType)
+ dispPriorVar <- estimateDispersionsPriorVar(objectNZ, modelMatrix=modelMatrix)
+
+ # need to condition on whether a beta prior needs to be fit
+ if (betaPrior) {
+
+ # if so,
+
+ # second parallel execution: fit the final dispersion estimates and MLE betas
+ if (!quiet) message(paste("final dispersion estimates, MLE betas:",nworkers,"workers"))
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ objectNZSub <- estimateDispersionsMAP(objectNZ[idx == l,,drop=FALSE],
+ dispPriorVar=dispPriorVar, quiet=TRUE)
+ # replace design
+ if (noReps) design(objectNZ) <- designIn
+ estimateMLEForBetaPriorVar(objectNZSub)
+ }, BPPARAM=BPPARAM))
+
+ # need to set standard model matrix for LRT with beta prior
+ if (test == "LRT") {
+ attr(object, "modelMatrixType") <- "standard"
+ attr(objectNZ, "modelMatrixType") <- "standard"
+ modelMatrixType <- "standard"
+ }
+
+ # the beta prior is estimated over all rows
+ betaPriorVar <- estimateBetaPriorVar(objectNZ)
+
+ # the third parallel execution: the final GLM and statistics
+ if (!quiet) message(paste("fitting model and testing:",nworkers,"workers"))
+ if (test == "Wald") {
+
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ nbinomWaldTest(objectNZ[idx == l,,drop=FALSE], betaPriorVar=betaPriorVar,
+ quiet=TRUE, modelMatrixType=modelMatrixType)
+ }, BPPARAM=BPPARAM))
+ } else if (test == "LRT") {
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ nbinomLRT(objectNZ[idx == l,,drop=FALSE], full=full, reduced=reduced,
+ betaPrior=betaPrior, betaPriorVar=betaPriorVar, quiet=TRUE)
+ }, BPPARAM=BPPARAM))
+ }
+
+ } else {
+
+ # or, if no beta prior to fit,
+
+ # second parallel execution: fit the final dispersion estimates and the final GLM and statistics
+ if (!quiet) message(paste("final dispersion estimates, fitting model and testing:",nworkers,"workers"))
+ if (test == "Wald") {
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ objectNZSub <- estimateDispersionsMAP(objectNZ[idx == l,,drop=FALSE],
+ dispPriorVar=dispPriorVar, quiet=TRUE, modelMatrix=modelMatrix)
+ # replace design
+ if (noReps) design(objectNZ) <- designIn
+ nbinomWaldTest(objectNZSub, betaPrior=betaPrior,
+ quiet=TRUE, modelMatrix=modelMatrix, modelMatrixType="standard")
+ }, BPPARAM=BPPARAM))
+ } else if (test == "LRT") {
+ objectNZ <- do.call(rbind, bplapply(levels(idx), function(l) {
+ objectNZSub <- estimateDispersionsMAP(objectNZ[idx == l,,drop=FALSE],
+ dispPriorVar=dispPriorVar, quiet=TRUE, modelMatrix=modelMatrix)
+ # replace design
+ if (noReps) design(objectNZ) <- designIn
+ nbinomLRT(objectNZSub, full=full, reduced=reduced, quiet=TRUE)
+ }, BPPARAM=BPPARAM))
+ }
+ }
+
+ outMcols <- buildDataFrameWithNARows(mcols(objectNZ), mcols(object)$allZero)
+ mcols(outMcols) <- mcols(mcols(objectNZ))
+ outMu <- buildMatrixWithNARows(assays(objectNZ)[["mu"]], mcols(object)$allZero)
+ outCooks <- buildMatrixWithNARows(assays(objectNZ)[["cooks"]], mcols(object)$allZero)
+
+ # now backfill any columns in rowRanges which existed before running DESeq()
+ # and which are not of type "intermediate" or "results"
+ object <- sanitizeRowRanges(object)
+ inMcols <- mcols(object)
+ namesCols <- names(mcols(object))
+ inputCols <- namesCols[! mcols(mcols(object))$type %in% c("intermediate","results")]
+ for (var in inputCols) {
+ outMcols[var] <- inMcols[var]
+ }
+
+ mcols(object) <- outMcols
+ object <- getBaseMeansAndVariances(object)
+ assays(object)[["mu"]] <- outMu
+ assays(object)[["cooks"]] <- outCooks
+
+ attrNames <- c("dispersionFunction","modelMatrixType","betaPrior",
+ "betaPriorVar","modelMatrix","test","dispModelMatrix")
+ for (attrName in attrNames) {
+ attr(object, attrName) <- attr(objectNZ, attrName)
+ }
+
+ object
+}
diff --git a/R/methods.R b/R/methods.R
new file mode 100644
index 0000000..06f85de
--- /dev/null
+++ b/R/methods.R
@@ -0,0 +1,776 @@
+counts.DESeqDataSet <- function(object, normalized=FALSE, replaced=FALSE) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ if (replaced) {
+ if ("replaceCounts" %in% assayNames(object)) {
+ cnts <- assays(object)[["replaceCounts"]]
+ } else {
+ warning("there are no assays named 'replaceCounts', using original.
+calling DESeq() will replace outliers if they are detected and store this assay.")
+ cnts <- assays(object)[["counts"]]
+ }
+ } else {
+ cnts <- assays(object)[["counts"]]
+ }
+ if (!normalized) {
+ return(cnts)
+ } else {
+ if (!is.null(normalizationFactors(object))) {
+ return( cnts / normalizationFactors(object) )
+ } else if (is.null(sizeFactors(object)) || any(is.na(sizeFactors(object)))) {
+ stop("first calculate size factors, add normalizationFactors, or set normalized=FALSE")
+ } else {
+ return( t( t( cnts ) / sizeFactors(object) ) )
+ }
+ }
+}
+
+#' Accessors for the 'counts' slot of a DESeqDataSet object.
+#'
+#' The counts slot holds the count data as a matrix of non-negative integer
+#' count values, one row for each observational unit (gene or the like), and one
+#' column for each sample.
+#'
+#' @docType methods
+#' @name counts
+#' @rdname counts
+#' @aliases counts counts,DESeqDataSet-method counts<-,DESeqDataSet,matrix-method
+#'
+#' @param object a \code{DESeqDataSet} object.
+#' @param normalized logical indicating whether or not to divide the counts by
+#' the size factors or normalization factors before returning
+#' (normalization factors always preempt size factors)
+#' @param replaced after a \code{DESeq} call, this argument will return the counts
+#' with outliers replaced instead of the original counts, and optionally \code{normalized}.
+#' The replaced counts are stored by \code{DESeq} in \code{assays(object)[['replaceCounts']]}.
+#' @param value an integer matrix
+#' @author Simon Anders
+#' @seealso \code{\link{sizeFactors}}, \code{\link{normalizationFactors}}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#' head(counts(dds))
+#'
+#' dds <- estimateSizeFactors(dds) # run this or DESeq() first
+#' head(counts(dds, normalized=TRUE))
+#'
+#' @export
+setMethod("counts", signature(object="DESeqDataSet"), counts.DESeqDataSet)
+
+#' @name counts
+#' @rdname counts
+#' @exportMethod "counts<-"
+setReplaceMethod("counts", signature(object="DESeqDataSet", value="matrix"),
+ function( object, value ) {
+ assays(object)[["counts"]] <- value
+ validObject(object)
+ object
+ })
+
+
+design.DESeqDataSet <- function(object) object at design
+
+#' Accessors for the 'design' slot of a DESeqDataSet object.
+#'
+#' The design holds the R \code{formula} which expresses how the
+#' counts depend on the variables in \code{colData}.
+#' See \code{\link{DESeqDataSet}} for details.
+#'
+#' @docType methods
+#' @name design
+#' @rdname design
+#' @aliases design design,DESeqDataSet-method design<-,DESeqDataSet,formula-method
+#' @param object a \code{DESeqDataSet} object
+#' @param value a \code{formula} used for estimating dispersion
+#' and fitting Negative Binomial GLMs
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#' design(dds) <- formula(~ 1)
+#'
+#' @export
+setMethod("design", signature(object="DESeqDataSet"), design.DESeqDataSet)
+
+#' @name design
+#' @rdname design
+#' @exportMethod "design<-"
+setReplaceMethod("design", signature(object="DESeqDataSet", value="formula"),
+ function( object, value ) {
+ # Temporary hack for backward compatibility with "old"
+ # DESeqDataSet objects. Remove once all serialized
+ # DESeqDataSet objects around have been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ object at design <- value
+ validObject(object)
+ object
+ })
+
+dispersionFunction.DESeqDataSet <- function(object) object at dispersionFunction
+
+#' Accessors for the 'dispersionFunction' slot of a DESeqDataSet object.
+#'
+#' The dispersion function is calculated by \code{\link{estimateDispersions}} and
+#' used by \code{\link{varianceStabilizingTransformation}}. Parametric dispersion
+#' fits store the coefficients of the fit as attributes in this slot.
+#'
+#' Setting this will also overwrite \code{mcols(object)$dispFit} and the estimate
+#' the variance of dispersion residuals, see \code{estimateVar} below.
+#'
+#' @docType methods
+#' @name dispersionFunction
+#' @rdname dispersionFunction
+#' @aliases dispersionFunction dispersionFunction,DESeqDataSet-method dispersionFunction<-,DESeqDataSet,function-method
+#' @param object a \code{DESeqDataSet} object.
+#' @param value a \code{function}
+#' @param estimateVar whether to estimate the variance of dispersion residuals.
+#' setting to FALSE is needed, e.g. within \code{estimateDispersionsMAP} when
+#' called on a subset of the full dataset in parallel execution.
+#' @param ... additional arguments
+#'
+#' @seealso \code{\link{estimateDispersions}}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' dispersionFunction(dds)
+#'
+#' @export
+setMethod("dispersionFunction", signature(object="DESeqDataSet"),
+ dispersionFunction.DESeqDataSet)
+
+#' @name dispersionFunction
+#' @rdname dispersionFunction
+#' @exportMethod "dispersionFunction<-"
+setReplaceMethod("dispersionFunction",
+ signature(object="DESeqDataSet", value="function"),
+ function(object, value, estimateVar=TRUE) {
+ # Temporary hack for backward compatibility with "old"
+ # DESeqDataSet objects. Remove once all serialized
+ # DESeqDataSet objects around have been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ if (estimateVar) {
+ if (is.null(mcols(object)$baseMean) | is.null(mcols(object)$allZero)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+
+ if (!is.null(mcols(object)$dispFit)) {
+ message("found already estimated fitted dispersions, removing these")
+ mcols(object) <- mcols(object)[,!names(mcols(object)) == "dispFit",drop=FALSE]
+ }
+
+ nonzeroIdx <- !mcols(object)$allZero
+ dispFit <- value(mcols(object)$baseMean[nonzeroIdx])
+ # if the function returns a single value, build the full vector
+ if (length(dispFit) == 1) {
+ dispFit <- rep(dispFit, sum(nonzeroIdx))
+ }
+ dispDataFrame <- buildDataFrameWithNARows(list(dispFit=dispFit),
+ mcols(object)$allZero)
+ mcols(dispDataFrame) <- DataFrame(type="intermediate",
+ description="fitted values of dispersion")
+ mcols(object) <- cbind(mcols(object), dispDataFrame)
+
+ # need to estimate variance of log dispersion residuals
+ minDisp <- 1e-8
+ dispGeneEst <- mcols(object)$dispGeneEst[nonzeroIdx]
+ aboveMinDisp <- dispGeneEst >= minDisp*100
+ if (sum(aboveMinDisp,na.rm=TRUE) > 0) {
+ dispResiduals <- log(dispGeneEst) - log(dispFit)
+ varLogDispEsts <- mad(dispResiduals[aboveMinDisp],na.rm=TRUE)^2
+ attr( value, "varLogDispEsts" ) <- varLogDispEsts
+ } else {
+ message("variance of dispersion residuals not estimated (necessary only for differential expression calling)")
+ }
+ }
+
+ object at dispersionFunction <- value
+ validObject(object)
+ object
+ })
+
+dispersions.DESeqDataSet <- function(object) mcols(object)$dispersion
+
+#' Accessor functions for the dispersion estimates in a DESeqDataSet
+#' object.
+#'
+#' The dispersions for each row of the DESeqDataSet. Generally,
+#' these are set by \code{\link{estimateDispersions}}.
+#'
+#' @docType methods
+#' @name dispersions
+#' @rdname dispersions
+#' @aliases dispersions dispersions,DESeqDataSet-method dispersions<-,DESeqDataSet,numeric-method
+#' @param object a \code{DESeqDataSet} object.
+#' @param value the dispersions to use for the Negative Binomial modeling
+#' @param ... additional arguments
+#'
+#' @author Simon Anders
+#' @seealso \code{\link{estimateDispersions}}
+#'
+#' @export
+setMethod("dispersions", signature(object="DESeqDataSet"),
+ dispersions.DESeqDataSet)
+
+#' @name dispersions
+#' @rdname dispersions
+#' @exportMethod "dispersions<-"
+setReplaceMethod("dispersions", signature(object="DESeqDataSet", value="numeric"),
+ function(object, value) {
+ firstRowDataColumn <- ncol(mcols(object)) == 0
+ mcols(object)$dispersion <- value
+ if (firstRowDataColumn) {
+ mcols(mcols(object)) <- DataFrame(type="input",
+ description="final estimate of dispersion")
+ }
+ validObject( object )
+ object
+ })
+
+
+sizeFactors.DESeqDataSet <- function(object) {
+ if (!"sizeFactor" %in% names(colData(object))) return(NULL)
+ sf <- object$sizeFactor
+ names( sf ) <- colnames( object )
+ sf
+}
+
+#' Accessor functions for the 'sizeFactors' information in a DESeqDataSet
+#' object.
+#'
+#' The sizeFactors vector assigns to each column of the count matrix a value, the
+#' size factor, such that count values in the columns can be brought to a common
+#' scale by dividing by the corresponding size factor (as performed by
+#' \code{counts(dds, normalized=TRUE)}).
+#' See \code{\link{DESeq}} for a description of the use of size factors. If gene-specific normalization
+#' is desired for each sample, use \code{\link{normalizationFactors}}.
+#'
+#' @docType methods
+#' @name sizeFactors
+#' @rdname sizeFactors
+#' @aliases sizeFactors sizeFactors,DESeqDataSet-method sizeFactors<-,DESeqDataSet,numeric-method
+#' @param object a \code{DESeqDataSet} object.
+#' @param value a numeric vector, one size factor for each column in the count
+#' data.
+#' @author Simon Anders
+#' @seealso \code{\link{estimateSizeFactors}}
+#'
+#' @export
+setMethod("sizeFactors", signature(object="DESeqDataSet"),
+ sizeFactors.DESeqDataSet)
+
+#' @name sizeFactors
+#' @rdname sizeFactors
+#' @exportMethod "sizeFactors<-"
+setReplaceMethod("sizeFactors", signature(object="DESeqDataSet", value="numeric"),
+ function( object, value ) {
+ if (any(value <= 0)) {
+ stop("size factors must be positive")
+ }
+ # Temporary hack for backward compatibility with "old"
+ # DESeqDataSet objects. Remove once all serialized
+ # DESeqDataSet objects around have been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ # have to make sure to remove sizeFactor which might be
+ # coming from a previous CountDataSet
+ object$sizeFactor <- value
+ idx <- which(colnames(colData(object)) == "sizeFactor")
+ metaDataFrame <- DataFrame(type="intermediate",
+ description="a scaling factor for columns")
+ mcols(colData(object))[idx,] <- metaDataFrame
+ validObject( object )
+ object
+ })
+
+normalizationFactors.DESeqDataSet <- function(object) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ if (!"normalizationFactors" %in% assayNames(object)) return(NULL)
+ assays(object)[["normalizationFactors"]]
+}
+
+#' Accessor functions for the normalization factors in a DESeqDataSet
+#' object.
+#'
+#' Gene-specific normalization factors for each sample can be provided as a matrix,
+#' which will preempt \code{\link{sizeFactors}}. In some experiments, counts for each
+#' sample have varying dependence on covariates, e.g. on GC-content for sequencing
+#' data run on different days, and in this case it makes sense to provide
+#' gene-specific factors for each sample rather than a single size factor.
+#'
+#' Normalization factors alter the model of \code{\link{DESeq}} in the following way, for
+#' counts \eqn{K_{ij}}{K_ij} and normalization factors \eqn{NF_{ij}}{NF_ij} for gene i and sample j:
+#'
+#' \deqn{ K_{ij} \sim \textrm{NB}( \mu_{ij}, \alpha_i) }{ K_ij ~ NB(mu_ij, alpha_i) }
+#' \deqn{ \mu_{ij} = NF_{ij} q_{ij} }{ mu_ij = NF_ij q_ij }
+#'
+#' @note Normalization factors are on the scale of the counts (similar to \code{\link{sizeFactors}})
+#' and unlike offsets, which are typically on the scale of the predictors (in this case, log counts).
+#' Normalization factors should include library size normalization. They should have
+#' row-wise geometric mean near 1, as is the case with size factors, such that the mean of normalized
+#' counts is close to the mean of unnormalized counts. See example code below.
+#'
+#' @docType methods
+#' @name normalizationFactors
+#' @rdname normalizationFactors
+#' @aliases normalizationFactors normalizationFactors,DESeqDataSet-method normalizationFactors<-,DESeqDataSet,matrix-method
+#' @param object a \code{DESeqDataSet} object.
+#' @param value the matrix of normalization factors
+#' @param ... additional arguments
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(n=100, m=4)
+#'
+#' normFactors <- matrix(runif(nrow(dds)*ncol(dds),0.5,1.5),
+#' ncol=ncol(dds),nrow=nrow(dds),
+#' dimnames=list(1:nrow(dds),1:ncol(dds)))
+#'
+#' # the normalization factors matrix should not have 0's in it
+#' # it should have geometric mean near 1 for each row
+#' normFactors <- normFactors / exp(rowMeans(log(normFactors)))
+#' normalizationFactors(dds) <- normFactors
+#'
+#' dds <- DESeq(dds)
+#'
+#' @export
+setMethod("normalizationFactors", signature(object="DESeqDataSet"),
+ normalizationFactors.DESeqDataSet)
+
+#' @name normalizationFactors
+#' @rdname normalizationFactors
+#' @exportMethod "normalizationFactors<-"
+setReplaceMethod("normalizationFactors", signature(object="DESeqDataSet", value="matrix"),
+ function(object, value) {
+ if (any(value <= 0)) {
+ stop("normalization factors must be positive")
+ }
+ # Temporary hack for backward compatibility with "old"
+ # DESeqDataSet objects. Remove once all serialized
+ # DESeqDataSet objects around have been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ # enforce same dimnames
+ dimnames(value) <- dimnames(object)
+ assays(object)[["normalizationFactors"]] <- value
+ validObject( object )
+ object
+ })
+
+estimateSizeFactors.DESeqDataSet <- function(object, type=c("ratio","iterate"),
+ locfunc=stats::median, geoMeans, controlGenes, normMatrix) {
+ type <- match.arg(type, c("ratio","iterate"))
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ object <- sanitizeColData(object)
+ if (type == "iterate") {
+ sizeFactors(object) <- estimateSizeFactorsIterate(object)
+ } else {
+ if (missing(normMatrix)) {
+ sizeFactors(object) <- estimateSizeFactorsForMatrix(counts(object), locfunc=locfunc,
+ geoMeans=geoMeans,
+ controlGenes=controlGenes)
+ } else {
+ normalizationFactors(object) <- estimateNormFactors(counts(object), normMatrix=normMatrix,
+ locfunc=locfunc,
+ geoMeans=geoMeans,
+ controlGenes=controlGenes)
+ message("adding normalization factors which account for library size")
+ }
+ }
+ object
+}
+
+#' Estimate the size factors for a DESeqDataSet
+#'
+#' This function estimates the size factors using the
+#' "median ratio method" described by Equation 5 in Anders and Huber (2010).
+#' The estimated size factors can be accessed using \code{\link{sizeFactors}}.
+#' Alternative library size estimators can also be supplied
+#' using \code{\link{sizeFactors}}.
+#'
+#' Typically, the function is called with the idiom:
+#'
+#' \code{dds <- estimateSizeFactors(dds)}
+#'
+#' See \code{\link{DESeq}} for a description of the use of size factors in the GLM.
+#' One should call this function after \code{\link{DESeqDataSet}}
+#' unless size factors are manually specified with \code{\link{sizeFactors}}.
+#' Alternatively, gene-specific normalization factors for each sample can be provided using
+#' \code{\link{normalizationFactors}} which will always preempt \code{\link{sizeFactors}}
+#' in calculations.
+#'
+#' Internally, the function calls \code{\link{estimateSizeFactorsForMatrix}},
+#' which provides more details on the calculation.
+#'
+#' @docType methods
+#' @name estimateSizeFactors
+#' @rdname estimateSizeFactors
+#' @aliases estimateSizeFactors estimateSizeFactors,DESeqDataSet-method
+#'
+#' @param object a DESeqDataSet
+#' @param type either "ratio" or "iterate". "ratio" uses the standard
+#' median ratio method introduced in DESeq. The size factor is the
+#' median ratio of the sample over a pseudosample: for each gene, the geometric mean
+#' of all samples. "iterate" offers an alternative estimator, which can be
+#' used even when all genes contain a sample with a zero. This estimator
+#' iterates between estimating the dispersion with a design of ~1, and
+#' finding a size factor vector by numerically optimizing the likelihood
+#' of the ~1 model.
+#' @param locfunc a function to compute a location for a sample. By default, the
+#' median is used. However, especially for low counts, the
+#' \code{\link[genefilter]{shorth}} function from the genefilter package may give better results.
+#' @param geoMeans by default this is not provided and the
+#' geometric means of the counts are calculated within the function.
+#' A vector of geometric means from another count matrix can be provided
+#' for a "frozen" size factor calculation
+#' @param controlGenes optional, numeric or logical index vector specifying those genes to
+#' use for size factor estimation (e.g. housekeeping or spike-in genes)
+#' @param normMatrix optional, a matrix of normalization factors which do not
+#' control for library size (e.g. average transcript length of genes for each
+#' sample). Providing \code{normMatrix} will estimate size factors on the
+#' count matrix divided by \code{normMatrix} and store the product of the
+#' size factors and \code{normMatrix} as \code{\link{normalizationFactors}}.
+#'
+#' @return The DESeqDataSet passed as parameters, with the size factors filled
+#' in.
+#' @author Simon Anders
+#' @seealso \code{\link{estimateSizeFactorsForMatrix}}
+#'
+#' @references
+#'
+#' Reference for the median ratio method:
+#'
+#' Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(n=1000, m=4)
+#' dds <- estimateSizeFactors(dds)
+#' sizeFactors(dds)
+#'
+#' dds <- estimateSizeFactors(dds, controlGenes=1:200)
+#'
+#' m <- matrix(runif(1000 * 4, .5, 1.5), ncol=4)
+#' dds <- estimateSizeFactors(dds, normMatrix=m)
+#' normalizationFactors(dds)[1:3,]
+#'
+#' geoMeans <- exp(rowMeans(log(counts(dds))))
+#' dds <- estimateSizeFactors(dds,geoMeans=geoMeans)
+#' sizeFactors(dds)
+#'
+#' @export
+setMethod("estimateSizeFactors", signature(object="DESeqDataSet"),
+ estimateSizeFactors.DESeqDataSet)
+
+estimateDispersions.DESeqDataSet <- function(object, fitType=c("parametric","local","mean"),
+ maxit=100, quiet=FALSE, modelMatrix=NULL) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ if (is.null(sizeFactors(object)) & is.null(normalizationFactors(object))) {
+ stop("first call estimateSizeFactors or provide a normalizationFactor matrix before estimateDispersions")
+ }
+ # size factors could have slipped in to colData from a previous run
+ if (!is.null(sizeFactors(object))) {
+ if (!is.numeric(sizeFactors(object))) {
+ stop("the sizeFactor column in colData is not numeric.
+this column could have come in during colData import and should be removed.")
+ }
+ if (any(is.na(sizeFactors(object)))) {
+ stop("the sizeFactor column in colData contains NA.
+this column could have come in during colData import and should be removed.")
+ }
+ }
+ if (all(rowSums(counts(object) == counts(object)[,1]) == ncol(object))) {
+ stop("all genes have equal values for all samples. will not be able to perform differential analysis")
+ }
+ if (!is.null(dispersions(object))) {
+ if (!quiet) message("found already estimated dispersions, replacing these")
+ mcols(object) <- mcols(object)[,!(mcols(mcols(object))$type %in% c("intermediate","results")),drop=FALSE]
+ }
+ stopifnot(length(maxit)==1)
+ fitType <- match.arg(fitType, choices=c("parametric","local","mean"))
+
+ noReps <- checkForExperimentalReplicates(object, modelMatrix)
+ if (noReps) {
+ designIn <- design(object)
+ design(object) <- formula(~ 1)
+ }
+
+ if (!quiet) message("gene-wise dispersion estimates")
+ object <- estimateDispersionsGeneEst(object, maxit=maxit, quiet=quiet, modelMatrix=modelMatrix)
+ if (!quiet) message("mean-dispersion relationship")
+ object <- estimateDispersionsFit(object, fitType=fitType, quiet=quiet)
+ if (!quiet) message("final dispersion estimates")
+ object <- estimateDispersionsMAP(object, maxit=maxit, quiet=quiet, modelMatrix=modelMatrix)
+
+ # replace the previous design
+ if (noReps) design(object) <- designIn
+
+ return(object)
+}
+
+checkForExperimentalReplicates <- function(object, modelMatrix) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ noReps <- if (is.null(modelMatrix)) {
+ mmtest <- model.matrix(design(object), data=as.data.frame(colData(object)))
+ nrow(mmtest) == ncol(mmtest)
+ } else {
+ nrow(modelMatrix) == ncol(modelMatrix)
+ }
+ if (noReps) {
+ if (!is.null(modelMatrix)) stop("same number of samples and coefficients to fit with supplied model matrix")
+ warning("same number of samples and coefficients to fit,
+ estimating dispersion by treating samples as replicates.
+ read the ?DESeq section on 'Experiments without replicates'")
+ }
+ noReps
+}
+
+#' Estimate the dispersions for a DESeqDataSet
+#'
+#' This function obtains dispersion estimates for Negative Binomial distributed data.
+#'
+#' Typically the function is called with the idiom:
+#'
+#' \code{dds <- estimateDispersions(dds)}
+#'
+#' The fitting proceeds as follows: for each gene, an estimate of the dispersion
+#' is found which maximizes the Cox Reid-adjusted profile likelihood
+#' (the methods of Cox Reid-adjusted profile likelihood maximization for
+#' estimation of dispersion in RNA-Seq data were developed by McCarthy,
+#' et al. (2012), first implemented in the edgeR package in 2010);
+#' a trend line capturing the dispersion-mean relationship is fit to the maximum likelihood estimates;
+#' a normal prior is determined for the log dispersion estimates centered
+#' on the predicted value from the trended fit
+#' with variance equal to the difference between the observed variance of the
+#' log dispersion estimates and the expected sampling variance;
+#' finally maximum a posteriori dispersion estimates are returned.
+#' This final dispersion parameter is used in subsequent tests.
+#' The final dispersion estimates can be accessed from an object using \code{\link{dispersions}}.
+#' The fitted dispersion-mean relationship is also used in
+#' \code{\link{varianceStabilizingTransformation}}.
+#' All of the intermediate values (gene-wise dispersion estimates, fitted dispersion
+#' estimates from the trended fit, etc.) are stored in \code{mcols(dds)}, with
+#' information about these columns in \code{mcols(mcols(dds))}.
+#'
+#' The log normal prior on the dispersion parameter has been proposed
+#' by Wu, et al. (2012) and is also implemented in the DSS package.
+#'
+#' In DESeq2, the dispersion estimation procedure described above replaces the
+#' different methods of dispersion from the previous version of the DESeq package.
+#'
+#' \code{estimateDispersions} checks for the case of an analysis
+#' with as many samples as the number of coefficients to fit,
+#' and will temporarily substitute a design formula \code{~ 1} for the
+#' purposes of dispersion estimation. This treats the samples as
+#' replicates for the purpose of dispersion estimation. As mentioned in the DESeq paper:
+#' "While one may not want to draw strong conclusions from such an analysis,
+#' it may still be useful for exploration and hypothesis generation."
+#'
+#' The lower-level functions called by \code{estimateDispersions} are:
+#' \code{\link{estimateDispersionsGeneEst}},
+#' \code{\link{estimateDispersionsFit}}, and
+#' \code{\link{estimateDispersionsMAP}}.
+#'
+#' @docType methods
+#' @name estimateDispersions
+#' @rdname estimateDispersions
+#' @aliases estimateDispersions estimateDispersions,DESeqDataSet-method
+#' @param object a DESeqDataSet
+#' @param fitType either "parametric", "local", or "mean"
+#' for the type of fitting of dispersions to the mean intensity.
+#' \itemize{
+#' \item parametric - fit a dispersion-mean relation of the form:
+#' \deqn{dispersion = asymptDisp + extraPois / mean}
+#' via a robust gamma-family GLM. The coefficients \code{asymptDisp} and \code{extraPois}
+#' are given in the attribute \code{coefficients} of the \code{\link{dispersionFunction}}
+#' of the object.
+#' \item local - use the locfit package to fit a local regression
+#' of log dispersions over log base mean (normal scale means and dispersions
+#' are input and output for \code{\link{dispersionFunction}}). The points
+#' are weighted by normalized mean count in the local regression.
+#' \item mean - use the mean of gene-wise dispersion estimates.
+#' }
+#' @param maxit control parameter: maximum number of iterations to allow for convergence
+#' @param quiet whether to print messages at each step
+#' @param modelMatrix an optional matrix which will be used for fitting the expected counts.
+#' by default, the model matrix is constructed from \code{design(object)}
+#'
+#' @return The DESeqDataSet passed as parameters, with the dispersion information
+#' filled in as metadata columns, accessible via \code{mcols}, or the final dispersions
+#' accessible via \code{\link{dispersions}}.
+#'
+#' @references \itemize{
+#' \item Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 11 (2010) R106, \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+#' \item McCarthy, DJ, Chen, Y, Smyth, GK: Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation. Nucleic Acids Research 40 (2012), 4288-4297, \url{http://dx.doi.org/10.1093/nar/gks042}
+#' \item Wu, H., Wang, C. & Wu, Z. A new shrinkage estimator for dispersion improves differential expression detection in RNA-seq data. Biostatistics (2012). \url{http://dx.doi.org/10.1093/biostatistics/kxs033}
+#' }
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' head(dispersions(dds))
+#'
+#' @export
+setMethod("estimateDispersions", signature(object="DESeqDataSet"),
+ estimateDispersions.DESeqDataSet)
+
+
+#' Show method for DESeqResults objects
+#'
+#' Prints out the information from the metadata columns
+#' of the results object regarding the log2 fold changes
+#' and p-values, then shows the DataFrame using the
+#' standard method.
+#'
+#' @docType methods
+#' @name show
+#' @rdname show
+#' @aliases show show,DESeqResults-method
+#' @author Michael Love
+#'
+#' @param object a DESeqResults object
+#'
+#' @export
+setMethod("show", signature(object="DESeqResults"), function(object) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ cat(mcols(object)$description[ colnames(object) == "log2FoldChange"],"\n")
+ cat(mcols(object)$description[ colnames(object) == "pvalue"],"\n")
+ show(DataFrame(object))
+})
+
+#' Extract a matrix of model coefficients/standard errors
+#'
+#' \strong{Note:} results tables with log2 fold change, p-values, adjusted p-values, etc.
+#' for each gene are best generated using the \code{\link{results}} function. The \code{coef}
+#' function is designed for advanced users who wish to inspect all model coefficients at once.
+#'
+#' Estimated model coefficients or estimated standard errors are provided in a matrix
+#' form, number of genes by number of parameters, on the log2 scale.
+#' The columns correspond to columns of the model matrix for final GLM fitting, i.e.,
+#' \code{attr(dds, "modelMatrix")}.
+#'
+#' @param object a DESeqDataSet returned by \code{\link{DESeq}}, \code{\link{nbinomWaldTest}},
+#' or \code{\link{nbinomLRT}}.
+#' @param SE whether to give the standard errors instead of coefficients.
+#' defaults to FALSE so that the coefficients are given.
+#' @param ... additional arguments
+#'
+#' @docType methods
+#' @name coef
+#' @rdname coef
+#' @aliases coef coef.DESeqDataSet
+#' @author Michael Love
+#' @importFrom stats coef
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#' dds <- DESeq(dds)
+#' coef(dds)[1,]
+#' coef(dds, SE=TRUE)[1,]
+#'
+#' @export
+coef.DESeqDataSet <- function(object, SE=FALSE, ...) {
+ # Temporary hack for backward compatibility with "old" DESeqDataSet
+ # objects. Remove once all serialized DESeqDataSet objects around have
+ # been updated.
+ if (!.hasSlot(object, "rowRanges"))
+ object <- updateObject(object)
+ resNms <- resultsNames(object)
+ if (length(resNms) == 0) {
+ stop("no coefficients have been generated yet, first call DESeq()")
+ }
+ if (!SE) {
+ as.matrix(mcols(object,use.names=TRUE)[resNms])
+ } else {
+ as.matrix(mcols(object,use.names=TRUE)[paste0("SE_",resNms)])
+ }
+}
+
+#' Summarize DESeq results
+#'
+#' Print a summary of the results from a DESeq analysis.
+#'
+#' @usage
+#' \method{summary}{DESeqResults}(object, alpha, \dots)
+#'
+#' @param object a \code{\link{DESeqResults}} object
+#' @param alpha the adjusted p-value cutoff. if not set, this
+#' defaults to the \code{alpha} argument which was used in
+#' \code{\link{results}} to set the target FDR for independent
+#' filtering.
+#' @param ... additional arguments
+#'
+#' @docType methods
+#' @name summary
+#' @rdname summary
+#' @aliases summary summary.DESeqResults
+#' @author Michael Love
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#' dds <- DESeq(dds)
+#' res <- results(dds)
+#' summary(res)
+#'
+#' @export
+summary.DESeqResults <- function(object, alpha, ...) {
+ if (missing(alpha)) {
+ alpha <- if (is.null(metadata(object)$alpha)) {
+ 0.1
+ } else {
+ metadata(object)$alpha
+ }
+ }
+ cat("\n")
+ notallzero <- sum(object$baseMean > 0)
+ up <- sum(object$padj < alpha & object$log2FoldChange > 0, na.rm=TRUE)
+ down <- sum(object$padj < alpha & object$log2FoldChange < 0, na.rm=TRUE)
+ filt <- sum(!is.na(object$pvalue) & is.na(object$padj))
+ outlier <- sum(object$baseMean > 0 & is.na(object$pvalue))
+ ft <- if (is.null(metadata(object)$filterThreshold)) {
+ 0
+ } else {
+ round(metadata(object)$filterThreshold)
+ }
+ printsig <- function(x) format(x, digits=2)
+ cat("out of",notallzero,"with nonzero total read count\n")
+ cat(paste0("adjusted p-value < ",alpha,"\n"))
+ cat(paste0("LFC > 0 (up) : ",up,", ",printsig(up/notallzero*100),"% \n"))
+ cat(paste0("LFC < 0 (down) : ",down,", ",printsig(down/notallzero*100),"% \n"))
+ cat(paste0("outliers [1] : ",outlier,", ",printsig(outlier/notallzero*100),"% \n"))
+ cat(paste0("low counts [2] : ",filt,", ",printsig(filt/notallzero*100),"% \n"))
+ cat(paste0("(mean count < ",ft,")\n"))
+ cat("[1] see 'cooksCutoff' argument of ?results\n")
+ cat("[2] see 'independentFiltering' argument of ?results\n")
+ cat("\n")
+}
diff --git a/R/plots.R b/R/plots.R
new file mode 100644
index 0000000..0701c2d
--- /dev/null
+++ b/R/plots.R
@@ -0,0 +1,355 @@
+plotDispEsts.DESeqDataSet <- function( object, ymin,
+ genecol = "black", fitcol = "red", finalcol = "dodgerblue",
+ legend=TRUE, xlab, ylab, log = "xy", cex = 0.45, ... )
+{
+ if (missing(xlab)) xlab <- "mean of normalized counts"
+ if (missing(ylab)) ylab <- "dispersion"
+
+ px = mcols(object)$baseMean
+ sel = (px>0)
+ px = px[sel]
+
+ py = mcols(object)$dispGeneEst[sel]
+ if(missing(ymin))
+ ymin = 10^floor(log10(min(py[py>0], na.rm=TRUE))-0.1)
+
+ plot(px, pmax(py, ymin), xlab=xlab, ylab=ylab,
+ log=log, pch=ifelse(py<ymin, 6, 20), col=genecol, cex=cex, ... )
+
+ # use a circle over outliers
+ pchOutlier <- ifelse(mcols(object)$dispOutlier[sel],1,16)
+ cexOutlier <- ifelse(mcols(object)$dispOutlier[sel],2*cex,cex)
+ lwdOutlier <- ifelse(mcols(object)$dispOutlier[sel],2,1)
+ if (!is.null(dispersions(object))) {
+ points(px, dispersions(object)[sel], col=finalcol, cex=cexOutlier,
+ pch=pchOutlier, lwd=lwdOutlier)
+ }
+
+ if (!is.null(mcols(object)$dispFit)) {
+ points(px, mcols(object)$dispFit[sel], col=fitcol, cex=cex, pch=16)
+ }
+
+ if (legend) {
+ legend("bottomright",c("gene-est","fitted","final"),pch=16,
+ col=c(genecol,fitcol,finalcol),bg="white")
+ }
+}
+
+#' Plot dispersion estimates
+#'
+#' A simple helper function that plots the per-gene dispersion
+#' estimates together with the fitted mean-dispersion relationship.
+#'
+#' @docType methods
+#' @name plotDispEsts
+#' @rdname plotDispEsts
+#' @aliases plotDispEsts plotDispEsts,DESeqDataSet-method
+#'
+#' @param object a DESeqDataSet, with dispersions estimated
+#' @param ymin the lower bound for points on the plot, points beyond this
+#' are drawn as triangles at ymin
+#' @param genecol the color for gene-wise dispersion estimates
+#' @param fitcol the color of the fitted estimates
+#' @param finalcol the color of the final estimates used for testing
+#' @param legend logical, whether to draw a legend
+#' @param xlab xlab
+#' @param ylab ylab
+#' @param log log
+#' @param cex cex
+#' @param ... further arguments to \code{plot}
+#'
+#' @author Simon Anders
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' plotDispEsts(dds)
+#'
+#' @export
+setMethod("plotDispEsts", signature(object="DESeqDataSet"), plotDispEsts.DESeqDataSet)
+
+plotMA.DESeqDataSet <- function(object, alpha=.1, main="", ylim, ...) {
+ res <- results(object, ...)
+ plotMA.DESeqResults(res, alpha=alpha, main=main, ylim=ylim)
+}
+
+plotMA.DESeqResults <- function(object, alpha, main="", ylim, MLE=FALSE, ...) {
+ if (missing(alpha)) {
+ alpha <- if (is.null(metadata(object)$alpha)) {
+ 0.1
+ } else {
+ metadata(object)$alpha
+ }
+ }
+ df <- if (MLE) {
+ # test if MLE is there
+ if (is.null(object$lfcMLE)) {
+ stop("lfcMLE column is not present: you should first run results() with addMLE=TRUE")
+ }
+ data.frame(mean = object$baseMean,
+ lfc = object$lfcMLE,
+ isDE = ifelse(is.na(object$padj), FALSE, object$padj < alpha))
+ } else {
+ data.frame(mean = object$baseMean,
+ lfc = object$log2FoldChange,
+ isDE = ifelse(is.na(object$padj), FALSE, object$padj < alpha))
+ }
+ if (missing(ylim)) {
+ plotMA(df, main=main, ...)
+ } else {
+ plotMA(df, main=main, ylim=ylim, ...)
+ }
+}
+
+#' MA-plot from base means and log fold changes
+#'
+#' A simple helper function that makes a so-called "MA-plot", i.e. a
+#' scatter plot of log2 fold changes (on the y-axis) versus the mean of
+#' normalized counts (on the x-axis).
+#'
+#' This function is essentially two lines of code: building a
+#' \code{data.frame} and passing this to the \code{plotMA} method
+#' for \code{data.frame} from the geneplotter package.
+#' The code of this function can be seen with:
+#' \code{getMethod("plotMA","DESeqDataSet")}
+#' If users wish to modify the graphical parameters of the plot,
+#' it is recommended to build the data.frame in the
+#' same manner and call \code{plotMA}.
+#'
+#' @docType methods
+#' @name plotMA
+#' @rdname plotMA
+#' @aliases plotMA plotMA,DESeqDataSet-method plotMA,DESeqResults-method
+#'
+#' @param object a \code{DESeqResults} object produced by \code{\link{results}};
+#' or a \code{DESeqDataSet} processed by \code{\link{DESeq}}, or the
+#' individual functions \code{\link{nbinomWaldTest}} or \code{\link{nbinomLRT}}
+#' @param alpha the significance level for thresholding adjusted p-values
+#' @param MLE whether to plot the MLE (unshrunken estimates), defaults to FALSE.
+#' Requires that \code{\link{results}} was run with \code{addMLE=TRUE}.
+#' Note that the MLE will be plotted regardless of this argument, if DESeq() was run
+#' with \code{betaPrior=FALSE}.
+#' @param main optional title for the plot
+#' @param ylim optional y limits
+#' @param ... further arguments passed to \code{plotMA} if object
+#' is \code{DESeqResults} or to \code{\link{results}} if object is
+#' \code{DESeqDataSet}
+#'
+#' @author Michael Love
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' dds <- DESeq(dds)
+#' plotMA(dds)
+#' res <- results(dds)
+#' plotMA(res)
+#'
+#' @importFrom geneplotter plotMA
+#' @importFrom ggplot2 ggplot geom_point xlab ylab coord_fixed aes_string
+#'
+#' @export
+setMethod("plotMA", signature(object="DESeqDataSet"), plotMA.DESeqDataSet)
+
+#' @name plotMA
+#' @rdname plotMA
+#' @export
+setMethod("plotMA", signature(object="DESeqResults"), plotMA.DESeqResults)
+
+plotPCA.DESeqTransform = function(object, intgroup="condition", ntop=500, returnData=FALSE)
+{
+ # calculate the variance for each gene
+ rv <- rowVars(assay(object))
+
+ # select the ntop genes by variance
+ select <- order(rv, decreasing=TRUE)[seq_len(min(ntop, length(rv)))]
+
+ # perform a PCA on the data in assay(x) for the selected genes
+ pca <- prcomp(t(assay(object)[select,]))
+
+ # the contribution to the total variance for each component
+ percentVar <- pca$sdev^2 / sum( pca$sdev^2 )
+
+ if (!all(intgroup %in% names(colData(object)))) {
+ stop("the argument 'intgroup' should specify columns of colData(dds)")
+ }
+
+ intgroup.df <- as.data.frame(colData(object)[, intgroup, drop=FALSE])
+
+ # add the intgroup factors together to create a new grouping factor
+ group <- if (length(intgroup) > 1) {
+ factor(apply( intgroup.df, 1, paste, collapse=" : "))
+ } else {
+ colData(object)[[intgroup]]
+ }
+
+ # assembly the data for the plot
+ d <- data.frame(PC1=pca$x[,1], PC2=pca$x[,2], group=group, intgroup.df, name=colnames(object))
+
+ if (returnData) {
+ attr(d, "percentVar") <- percentVar[1:2]
+ return(d)
+ }
+
+ ggplot(data=d, aes_string(x="PC1", y="PC2", color="group")) + geom_point(size=3) +
+ xlab(paste0("PC1: ",round(percentVar[1] * 100),"% variance")) +
+ ylab(paste0("PC2: ",round(percentVar[2] * 100),"% variance")) +
+ coord_fixed()
+}
+
+#' Sample PCA plot for transformed data
+#'
+#' This plot helps to check for batch effects and the like.
+#'
+#' @docType methods
+#' @name plotPCA
+#' @rdname plotPCA
+#' @aliases plotPCA plotPCA,DESeqTransform-method
+#'
+#' @param object a \code{\link{DESeqTransform}} object, with data in \code{assay(x)},
+#' produced for example by either \code{\link{rlog}} or
+#' \code{\link{varianceStabilizingTransformation}}.
+#' @param intgroup interesting groups: a character vector of
+#' names in \code{colData(x)} to use for grouping
+#' @param ntop number of top genes to use for principal components,
+#' selected by highest row variance
+#' @param returnData should the function only return the data.frame of PC1 and PC2
+#' with intgroup covariates for custom plotting (default is FALSE)
+#'
+#' @return An object created by \code{ggplot}, which can be assigned and further customized.
+#'
+#' @author Wolfgang Huber
+#'
+#' @note See the vignette for an example of variance stabilization and PCA plots.
+#' Note that the source code of \code{plotPCA} is very simple.
+#' The source can be found by typing \code{DESeq2:::plotPCA.DESeqTransform}
+#' or \code{getMethod("plotPCA","DESeqTransform")}, or
+#' browsed on github at \url{https://github.com/Bioconductor-mirror/DESeq2/blob/master/R/plots.R}
+#' Users should find it easy to customize this function.
+#'
+#' @examples
+#'
+#' # using rlog transformed data:
+#' dds <- makeExampleDESeqDataSet(betaSD=1)
+#' rld <- rlog(dds)
+#' plotPCA(rld)
+#'
+#' # also possible to perform custom transformation:
+#' dds <- estimateSizeFactors(dds)
+#' # shifted log of normalized counts
+#' se <- SummarizedExperiment(log2(counts(dds, normalized=TRUE) + 1),
+#' colData=colData(dds))
+#' # the call to DESeqTransform() is needed to
+#' # trigger our plotPCA method.
+#' plotPCA( DESeqTransform( se ) )
+#'
+#' @export
+setMethod("plotPCA", signature(object="DESeqTransform"), plotPCA.DESeqTransform)
+
+#' Plot of normalized counts for a single gene on log scale
+#'
+#' Note: normalized counts plus a pseudocount of 0.5 are shown.
+#'
+#' @param dds a \code{DESeqDataSet}
+#' @param gene a character, specifying the name of the gene to plot
+#' @param intgroup interesting groups: a character vector of names in \code{colData(x)} to use for grouping
+#' @param normalized whether the counts should be normalized by size factor
+#' (default is TRUE)
+#' @param transform whether to present log2 counts (TRUE) or
+#' to present the counts on the log scale (FALSE, default)
+#' @param main as in 'plot'
+#' @param xlab as in 'plot'
+#' @param returnData should the function only return the data.frame of counts and
+#' covariates for custom plotting (default is FALSE)
+#' @param replaced use the outlier-replaced counts if they exist
+#' @param ... arguments passed to plot
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet()
+#' plotCounts(dds, "gene1")
+#'
+#' @export
+plotCounts <- function(dds, gene, intgroup="condition",
+ normalized=TRUE, transform=FALSE,
+ main, xlab="group",
+ returnData=FALSE,
+ replaced=FALSE, ...) {
+ stopifnot(length(gene) == 1 & (is.character(gene) | (is.numeric(gene) & (gene >= 1 & gene <= nrow(dds)))))
+ if (!all(intgroup %in% names(colData(dds)))) stop("all variables in 'intgroup' must be columns of colData")
+ stopifnot(returnData | all(sapply(intgroup, function(v) is(colData(dds)[[v]], "factor"))))
+ if (is.null(sizeFactors(dds)) & is.null(normalizationFactors(dds))) {
+ dds <- estimateSizeFactors(dds)
+ }
+ cnts <- counts(dds,normalized=normalized,replaced=replaced)[gene,]
+ group <- if (length(intgroup) == 1) {
+ colData(dds)[[intgroup]]
+ } else if (length(intgroup) == 2) {
+ lvls <- as.vector(t(outer(levels(colData(dds)[[intgroup[1]]]),
+ levels(colData(dds)[[intgroup[2]]]),
+ function(x,y) paste(x,y,sep=" : "))))
+ droplevels(factor(apply( as.data.frame(colData(dds)[, intgroup, drop=FALSE]),
+ 1, paste, collapse=" : "), levels=lvls))
+ } else {
+ factor(apply( as.data.frame(colData(dds)[, intgroup, drop=FALSE]),
+ 1, paste, collapse=" : "))
+ }
+ data <- data.frame(count=cnts + .5, group=as.integer(group))
+ if (transform) {
+ data$count <- log2(data$count)
+ ylab <- expression(log[2]~count)
+ logxy <- ""
+ } else {
+ ylab <- ifelse(normalized,"normalized count","count")
+ logxy <- "y"
+ }
+ if (missing(main)) {
+ main <- if (is.numeric(gene)) {
+ rownames(dds)[gene]
+ } else {
+ gene
+ }
+ }
+ if (returnData) return(data.frame(count=data$count, colData(dds)[intgroup]))
+ plot(data$group + runif(ncol(dds),-.05,.05), data$count, xlim=c(.5,max(data$group)+.5),
+ log=logxy, xaxt="n", xlab=xlab, ylab=ylab, main=main, ...)
+ axis(1, at=seq_along(levels(group)), levels(group))
+}
+
+
+#' Sparsity plot
+#'
+#' A simple plot of the concentration of counts in a single sample over the
+#' sum of counts per gene. Not technically the same as "sparsity", but this
+#' plot is useful diagnostic for datasets which might not fit a negative
+#' binomial assumption: genes with many zeros and individual very large
+#' counts are difficult to model with the negative binomial distribution.
+#'
+#' @param x a matrix or DESeqDataSet
+#' @param normalized whether to normalize the counts from a DESeqDataSEt
+#' @param ... passed to \code{plot}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(n=1000,m=4,dispMeanRel=function(x) .5)
+#' dds <- estimateSizeFactors(dds)
+#' plotSparsity(dds)
+#'
+#' @export
+plotSparsity <- function(x, normalized=TRUE, ...) {
+ if (is(x, "DESeqDataSet")) {
+ x <- counts(x, normalized=normalized)
+ }
+ rs <- rowSums(x)
+ rmx <- apply(x, 1, max)
+ plot(rs[rs > 0], (rmx/rs)[rs > 0], log="x", ylim=c(0,1), xlab="sum of counts per gene",
+ ylab="max count / sum", main="Concentration of counts over total sum of counts", ...)
+}
+
+# convenience function for adding alpha transparency to named colors
+## col2useful <- function(col,alpha) {
+## x <- col2rgb(col)/255
+## rgb(x[1],x[2],x[3],alpha)
+## }
diff --git a/R/results.R b/R/results.R
new file mode 100644
index 0000000..bdd4dc4
--- /dev/null
+++ b/R/results.R
@@ -0,0 +1,1089 @@
+#' Extract results from a DESeq analysis
+#'
+#' \code{results} extracts a result table from a DESeq analysis giving base means across samples,
+#' log2 fold changes, standard errors, test statistics, p-values and adjusted p-values;
+#' \code{resultsNames} returns the names of the estimated effects (coefficents) of the model;
+#' \code{removeResults} returns a \code{DESeqDataSet} object with results columns removed.
+#'
+#' The results table when printed will provide the information about
+#' the comparison, e.g. "log2 fold change (MAP): condition treated vs untreated", meaning
+#' that the estimates are of log2(treated / untreated), as would be returned by
+#' \code{contrast=c("condition","treated","untreated")}.
+#' Multiple results can be returned for analyses beyond a simple two group comparison,
+#' so \code{results} takes arguments \code{contrast} and \code{name} to help
+#' the user pick out the comparisons of interest for printing a results table.
+#' The use of the \code{contrast} argument is recommended for exact specification
+#' of the levels which should be compared and their order.
+#'
+#' If \code{results} is run without specifying \code{contrast} or \code{name},
+#' it will return the comparison of the last level of the last variable in the
+#' design formula over the first level of this variable. For example, for a simple two-group
+#' comparison, this would return the log2 fold changes of the second group over the
+#' first group (the reference level). Please see examples below and in the vignette.
+#'
+#' The argument \code{contrast} can be used to generate results tables for
+#' any comparison of interest, for example, the log2 fold change between
+#' two levels of a factor, and its usage is described below. It can also
+#' accomodate more complicated numeric comparisons.
+#' The test statistic used for a contrast is:
+#'
+#' \deqn{ c^t \beta / \sqrt{c^t \Sigma c } }{ c' beta / sqrt( c' Sigma c ) }
+#'
+#' The argument \code{name} can be used to generate results tables for
+#' individual effects, which must be individual elements of \code{resultsNames(object)}.
+#' These individual effects could represent continuous covariates, effects
+#' for individual levels, or individual interaction effects.
+#'
+#' Information on the comparison which was used to build the results table,
+#' and the statistical test which was used for p-values (Wald test or likelihood ratio test)
+#' is stored within the object returned by \code{results}. This information is in
+#' the metadata columns of the results table, which is accessible by calling \code{mcols}
+#' on the \code{\link{DESeqResults}} object returned by \code{results}.
+#'
+#' On p-values:
+#'
+#' By default, independent filtering is performed to select a set of genes
+#' for multiple test correction which maximizes the number of adjusted
+#' p-values less than a given critical value \code{alpha} (by default 0.1).
+#' The filter used for maximizing the number of rejections is the mean
+#' of normalized counts for all samples in the dataset.
+#' In version >= 1.10, the threshold chosen is
+#' the lowest quantile of the filter for which the
+#' number of rejections is close to the peak of a curve fit
+#' to the number of rejections over the filter quantiles.
+#' 'Close to' is defined as within 1 residual standard deviation.
+#'
+#' The adjusted p-values for the genes which do not pass the filter threshold
+#' are set to \code{NA}. By default, the mean of normalized counts
+#' is used to perform this filtering, though other statistics can be provided.
+#' Several arguments from the \code{filtered_p} function of genefilter
+#' are provided here to control or turn off the independent filtering behavior.
+#'
+#' By default, \code{results} assigns a p-value of \code{NA}
+#' to genes containing count outliers, as identified using Cook's distance.
+#' See the \code{cooksCutoff} argument for control of this behavior.
+#' Cook's distances for each sample are accessible as a matrix "cooks"
+#' stored in the \code{assays()} list. This measure is useful for identifying rows where the
+#' observed counts might not fit to a Negative Binomial distribution.
+#'
+#' For analyses using the likelihood ratio test (using \code{\link{nbinomLRT}}),
+#' the p-values are determined solely by the difference in deviance between
+#' the full and reduced model formula. A log2 fold change is included,
+#' which can be controlled using the \code{name} argument, or by default this will
+#' be the estimated coefficient for the last element of \code{resultsNames(object)}.
+#'
+#' @references Richard Bourgon, Robert Gentleman, Wolfgang Huber: Independent
+#' filtering increases detection power for high-throughput experiments.
+#' PNAS (2010), \url{http://dx.doi.org/10.1073/pnas.0914005107}
+#'
+#' @param object a DESeqDataSet, on which one
+#' of the following functions has already been called:
+#' \code{\link{DESeq}}, \code{\link{nbinomWaldTest}}, or \code{\link{nbinomLRT}}
+#' @param contrast this argument specifies what comparison to extract from
+#' the \code{object} to build a results table. one of either:
+#' \itemize{
+#' \item a character vector with exactly three elements:
+#' the name of a factor in the design formula,
+#' the name of the numerator level for the fold change,
+#' and the name of the denominator level for the fold change
+#' (simplest case)
+#' \item a list of 2 character vectors: the names of the fold changes
+#' for the numerator, and the names of the fold changes
+#' for the denominator.
+#' these names should be elements of \code{resultsNames(object)}.
+#' if the list is length 1, a second element is added which is the
+#' empty character vector, \code{character()}.
+#' (more general case, can be to combine interaction terms and main effects)
+#' \item a numeric contrast vector with one element
+#' for each element in \code{resultsNames(object)} (most general case)
+#' }
+#' If specified, the \code{name} argument is ignored.
+#' @param name the name of the individual effect (coefficient) for
+#' building a results table. Use this argument rather than \code{contrast}
+#' for continuous variables, individual effects or for individual interaction terms.
+#' The value provided to \code{name} must be an element of \code{resultsNames(object)}.
+#' @param lfcThreshold a non-negative value, which specifies the test which should
+#' be applied to the log2 fold changes. The standard is a test that the log2 fold
+#' changes are not equal to zero. However, log2 fold changes greater or less than
+#' \code{lfcThreshold} can also be tested. Specify the alternative hypothesis
+#' using the \code{altHypothesis} argument. If \code{lfcThreshold} is specified,
+#' the results are Wald tests, and LRT p-values will be overwritten.
+#' @param altHypothesis character which specifies the alternative hypothesis,
+#' i.e. those values of log2 fold change which the user is interested in
+#' finding. The complement of this set of values is the null hypothesis which
+#' will be tested. If the log2 fold change specified by \code{name}
+#' or by \code{contrast} is written as \eqn{ \beta }{ beta }, then the possible values for
+#' \code{altHypothesis} represent the following alternate hypotheses:
+#' \itemize{
+#' \item greaterAbs: \eqn{|\beta| > \textrm{lfcThreshold} }{ |beta| > lfcThreshold },
+#' and p-values are two-tailed
+#' \item lessAbs: \eqn{ |\beta| < \textrm{lfcThreshold} }{ |beta| < lfcThreshold },
+#' NOTE: this requires that \code{betaPrior=FALSE} has been specified in the
+#' previous \code{\link{DESeq}} call.
+#' p-values are the maximum of the upper and lower tests.
+#' \item greater: \eqn{ \beta > \textrm{lfcThreshold} }{ beta > lfcThreshold }
+#' \item less: \eqn{ \beta < -\textrm{lfcThreshold} }{ beta < -lfcThreshold }
+#' }
+#' @param listValues only used if a list is provided to \code{contrast}:
+#' a numeric of length two: the log2 fold changes in the list are multiplied by these values.
+#' the first number should be positive and the second negative.
+#' by default this is \code{c(1,-1)}
+#' @param cooksCutoff theshold on Cook's distance, such that if one or more
+#' samples for a row have a distance higher, the p-value for the row is
+#' set to NA.
+#' The default cutoff is the .99 quantile of the F(p, m-p) distribution,
+#' where p is the number of coefficients being fitted and m is the number of samples.
+#' Set to Inf or FALSE to disable the resetting of p-values to NA.
+#' Note: this test excludes the Cook's distance of samples belonging to experimental
+#' groups with only 2 samples.
+#' @param independentFiltering logical, whether independent filtering should be
+#' applied automatically
+#' @param alpha the significance cutoff used for optimizing the independent
+#' filtering (by default 0.1). If the adjusted p-value cutoff (FDR) will be a
+#' value other than 0.1, \code{alpha} should be set to that value.
+#' @param filter the vector of filter statistics over which the independent
+#' filtering will be optimized. By default the mean of normalized counts is used.
+#' @param theta the quantiles at which to assess the number of rejections
+#' from independent filtering
+#' @param pAdjustMethod the method to use for adjusting p-values, see \code{?p.adjust}
+#' @param filterFun an optional custom function for independent filtering,
+#' with arguments \code{alpha}, \code{filter}, \code{test}, \code{theta}, and \code{method}
+#' similar to \code{genefilter::filtered_R}, and which returns \code{padj}
+#' @param format character, either \code{"DataFrame"}, \code{"GRanges"}, or \code{"GRangesList"},
+#' whether the results should be printed as a \code{\link{DESeqResults}} DataFrame,
+#' or if the results DataFrame should be attached as metadata columns to
+#' the \code{GRanges} or \code{GRangesList} \code{rowRanges} of the \code{DESeqDataSet}.
+#' If the \code{rowRanges} is a \code{GRangesList}, and \code{GRanges} is requested,
+#' the range of each gene will be returned
+#' @param test this is typically automatically detected internally.
+#' the one exception is after \code{nbinomLRT} has been run, \code{test="Wald"}
+#' will generate Wald statistics and Wald test p-values.
+#' @param addMLE whether the "unshrunken" maximum likelihood estimates (MLE)
+#' of log2 fold change should be added as a column to the results table (default is FALSE).
+#' only applicable when a beta prior was used during the model fitting. only implemented
+#' for 'contrast' for three element character vectors or 'name' for interactions.
+#' @param tidy whether to output the results table with rownames as a first column 'row'.
+#' the table will also be coerced to \code{data.frame}
+#' @param parallel if FALSE, no parallelization. if TRUE, parallel
+#' execution using \code{BiocParallel}, see next argument \code{BPPARAM}
+#' @param BPPARAM an optional parameter object passed internally
+#' to \code{\link{bplapply}} when \code{parallel=TRUE}.
+#' If not specified, the parameters last registered with
+#' \code{\link{register}} will be used.
+#'
+#' @return For \code{results}: a \code{\link{DESeqResults}} object, which is
+#' a simple subclass of DataFrame. This object contains the results columns:
+#' \code{baseMean}, \code{log2FoldChange}, \code{lfcSE}, \code{stat},
+#' \code{pvalue} and \code{padj},
+#' and also includes metadata columns of variable information.
+#' The \code{lfcSE} gives the standard error of the \code{log2FoldChange}.
+#' For the Wald test, \code{stat} is the Wald statistic: the \code{log2FoldChange}
+#' divided by \code{lfcSE}, which is compared to a standard Normal distribution
+#' to generate a two-tailed \code{pvalue}. For the likelihood ratio test (LRT),
+#' \code{stat} is the difference in deviance between the reduced model and the full model,
+#' which is compared to a chi-squared distribution to generate a \code{pvalue}.
+#'
+#' For \code{resultsNames}: the names of the columns available as results,
+#' usually a combination of the variable name and a level
+#'
+#' For \code{removeResults}: the original \code{DESeqDataSet} with results metadata columns removed
+#'
+#' @seealso \code{\link{DESeq}}
+#'
+#' @examples
+#'
+#' ## Example 1: simple two-group comparison
+#'
+#' dds <- makeExampleDESeqDataSet(m=4)
+#'
+#' dds <- DESeq(dds)
+#' res <- results(dds)
+#' res[ order(res$padj), ]
+#'
+#' ## Example 2: two conditions, two genotypes, with an interaction term
+#'
+#' dds <- makeExampleDESeqDataSet(n=100,m=12)
+#' dds$genotype <- factor(rep(rep(c("I","II"),each=3),2))
+#'
+#' design(dds) <- ~ genotype + condition + genotype:condition
+#' dds <- DESeq(dds)
+#' resultsNames(dds)
+#'
+#' # Note: design with interactions terms by default have betaPrior=FALSE
+#'
+#' # the condition effect for genotype I (the main effect)
+#' results(dds, contrast=c("condition","B","A"))
+#'
+#' # the condition effect for genotype II
+#' # this is, by definition, the main effect *plus* the interaction term
+#' # (the extra condition effect in genotype II compared to genotype I).
+#' results(dds, list( c("condition_B_vs_A","genotypeII.conditionB") ))
+#'
+#' # the interaction term, answering: is the condition effect *different* across genotypes?
+#' results(dds, name="genotypeII.conditionB")
+#'
+#' ## Example 3: two conditions, three genotypes
+#'
+#' # ~~~ Using interaction terms ~~~
+#'
+#' dds <- makeExampleDESeqDataSet(n=100,m=18)
+#' dds$genotype <- factor(rep(rep(c("I","II","III"),each=3),2))
+#' design(dds) <- ~ genotype + condition + genotype:condition
+#' dds <- DESeq(dds)
+#' resultsNames(dds)
+#'
+#' # the condition effect for genotype I (the main effect)
+#' results(dds, contrast=c("condition","B","A"))
+#'
+#' # the condition effect for genotype III.
+#' # this is the main effect *plus* the interaction term
+#' # (the extra condition effect in genotype III compared to genotype I).
+#' results(dds, contrast=list( c("condition_B_vs_A","genotypeIII.conditionB") ))
+#'
+#' # the interaction term for condition effect in genotype III vs genotype I.
+#' # this tests if the condition effect is different in III compared to I
+#' results(dds, name="genotypeIII.conditionB")
+#'
+#' # the interaction term for condition effect in genotype III vs genotype II.
+#' # this tests if the condition effect is different in III compared to II
+#' results(dds, contrast=list("genotypeIII.conditionB", "genotypeII.conditionB"))
+#'
+#' # Note that a likelihood ratio could be used to test if there are any
+#' # differences in the condition effect between the three genotypes.
+#'
+#' # ~~~ Using a grouping variable ~~~
+#'
+#' # This is a useful construction when users just want to compare
+#' # specific groups which are combinations of variables.
+#'
+#' dds$group <- factor(paste0(dds$genotype, dds$condition))
+#' design(dds) <- ~ group
+#' dds <- DESeq(dds)
+#' resultsNames(dds)
+#'
+#' # the condition effect for genotypeIII
+#' results(dds, contrast=c("group", "IIIB", "IIIA"))
+#'
+#' @rdname results
+#' @aliases results resultsNames removeResults
+#' @export
+results <- function(object, contrast, name,
+ lfcThreshold=0,
+ altHypothesis=c("greaterAbs","lessAbs","greater","less"),
+ listValues=c(1,-1),
+ cooksCutoff,
+ independentFiltering=TRUE,
+ alpha=0.1, filter, theta,
+ pAdjustMethod="BH",
+ filterFun,
+ format=c("DataFrame","GRanges","GRangesList"),
+ test,
+ addMLE=FALSE,
+ tidy=FALSE,
+ parallel=FALSE, BPPARAM=bpparam()) {
+ # match args
+ format <- match.arg(format, choices=c("DataFrame", "GRanges","GRangesList"))
+ altHypothesis <- match.arg(altHypothesis, choices=c("greaterAbs","lessAbs","greater","less"))
+
+ if (!missing(test)) {
+ test <- match.arg(test, choices=c("Wald","LRT"))
+ }
+
+ # initial argument testing
+ stopifnot(lfcThreshold >= 0)
+ stopifnot(length(lfcThreshold)==1)
+ stopifnot(length(alpha)==1)
+ stopifnot(length(pAdjustMethod)==1)
+ stopifnot(length(listValues)==2 & is.numeric(listValues))
+ stopifnot(listValues[1] > 0 & listValues[2] < 0)
+ if (!"results" %in% mcols(mcols(object))$type) {
+ stop("couldn't find results. you should first run DESeq()")
+ }
+ if (missing(test)) {
+ test <- attr(object, "test")
+ } else if (test == "Wald" & attr(object, "test") == "LRT") {
+ # initially test was LRT, now need to add Wald statistics and p-values
+ object <- makeWaldTest(object)
+ } else if (test == "LRT" & attr(object, "test") == "Wald") {
+ stop("the LRT requires the user run nbinomLRT or DESeq(dds,test='LRT')")
+ }
+ if (lfcThreshold == 0 & altHypothesis == "lessAbs") {
+ stop("when testing altHypothesis='lessAbs', set the argument lfcThreshold to a positive value")
+ }
+
+ if (addMLE) {
+ if (!attr(object,"betaPrior")) {
+ stop("addMLE=TRUE is only for when a beta prior was used.
+otherwise, the log2 fold changes are already MLE")
+ }
+ if (!missing(name) & missing(contrast)) {
+ stop("addMLE=TRUE should be used by providing character vector
+of length 3 to 'contrast' instead of using 'name'")
+ }
+ }
+
+ if (format == "GRanges" & is(rowRanges(object),"GRangesList")) {
+ if (any(elementLengths(rowRanges(object)) == 0)) {
+ stop("rowRanges is GRangesList and one or more GRanges have length 0. Use format='DataFrame' or 'GRangesList'")
+ }
+ }
+ if (!missing(contrast)) {
+ if (attr(object,"modelMatrixType") == "user-supplied" & is.character(contrast)) {
+ stop("only list- and numeric-type contrasts are supported for user-supplied model matrices")
+ }
+ }
+
+ hasIntercept <- attr(terms(design(object)),"intercept") == 1
+ isExpanded <- attr(object, "modelMatrixType") == "expanded"
+ termsOrder <- attr(terms.formula(design(object)),"order")
+
+ # if neither 'contrast' nor 'name' were specified, create the default result table:
+ # the last level / first level for the last variable in design.
+ # (unless there are interactions, in which case the lastCoefName is pulled below)
+ if ((test == "Wald") & (isExpanded | !hasIntercept) & missing(contrast) & missing(name) & all(termsOrder < 2)) {
+ designVars <- all.vars(design(object))
+ lastVarName <- designVars[length(designVars)]
+ lastVar <- colData(object)[[lastVarName]]
+ if (is.factor(lastVar)) {
+ nlvls <- nlevels(lastVar)
+ contrast <- c(lastVarName, levels(lastVar)[nlvls], levels(lastVar)[1])
+ }
+ }
+
+ if (missing(name)) {
+ name <- lastCoefName(object)
+ } else {
+ if (length(name) != 1 | !is.character(name)) {
+ stop("the argument 'name' should be a character vector of length 1")
+ }
+ }
+
+ WaldResults <- paste0("WaldPvalue_",name) %in% names(mcols(object))
+ LRTResults <- "LRTPvalue" %in% names(mcols(object))
+
+ # if performing a contrast call the function cleanContrast()
+ if (!missing(contrast)) {
+ resNames <- resultsNames(object)
+ # do some arg checking/cleaning
+ contrast <- checkContrast(contrast, resNames)
+
+ ### cleanContrast call ###
+ # need to go back to C++ code in order to build the beta covariance matrix
+ # then this is multiplied by the numeric contrast to get the Wald statistic.
+ # with 100s of samples, this can get slow, so offer parallelization
+ res <- if (!parallel) {
+ cleanContrast(object, contrast, expanded=isExpanded, listValues=listValues, test=test)
+ } else if (parallel) {
+ nworkers <- BPPARAM$workers
+ idx <- factor(sort(rep(seq_len(nworkers),length=nrow(object))))
+ do.call(rbind, bplapply(levels(idx), function(l) {
+ cleanContrast(object[idx == l,,drop=FALSE], contrast,
+ expanded=isExpanded, listValues=listValues, test=test)
+ }, BPPARAM=BPPARAM))
+ }
+
+ } else {
+ # if not performing a contrast
+ # pull relevant columns from mcols(object)
+ log2FoldChange <- getCoef(object, name)
+ lfcSE <- getCoefSE(object, name)
+ stat <- getStat(object, test, name)
+ pvalue <- getPvalue(object, test, name)
+ res <- cbind(mcols(object)["baseMean"],log2FoldChange,lfcSE,stat,pvalue)
+ names(res) <- c("baseMean","log2FoldChange","lfcSE","stat","pvalue")
+ }
+
+ rownames(res) <- rownames(object)
+
+ # add unshrunken MLE coefficients to the results table
+ if (addMLE) {
+ if (is.numeric(contrast)) stop("addMLE only implemented for: contrast=c('condition','B','A')")
+ if (is.list(contrast)) stop("addMLE only implemented for: contrast=c('condition','B','A')")
+ res <- cbind(res, mleContrast(object, contrast))
+ res <- res[,c("baseMean","log2FoldChange","lfcMLE","lfcSE","stat","pvalue")]
+ # if an all zero contrast, also zero out the lfcMLE
+ res$lfcMLE[ which(res$log2FoldChange == 0 & res$stat == 0) ] <- 0
+ }
+
+ # only if we need to generate new p-values
+ if ( !(lfcThreshold == 0 & altHypothesis == "greaterAbs") ) {
+ if (test == "LRT") {
+ stop("tests of log fold change above or below a theshold must be Wald tests.")
+ }
+ if (altHypothesis == "greaterAbs") {
+ newStat <- sign(res$log2FoldChange) * pmax(0, (abs(res$log2FoldChange) - lfcThreshold)) / res$lfcSE
+ newPvalue <- pmin(1, 2 * pnorm(abs(res$log2FoldChange), mean = lfcThreshold,
+ sd = res$lfcSE, lower.tail = FALSE))
+ } else if (altHypothesis == "lessAbs") {
+ # check requirement if betaPrior was set to FALSE
+ if (attr(object,"betaPrior")) {
+ stop("testing altHypothesis='lessAbs' requires setting the DESeq() argument betaPrior=FALSE")
+ }
+ newStatAbove <- pmax(0, lfcThreshold - res$log2FoldChange) / res$lfcSE
+ pvalueAbove <- pnorm(res$log2FoldChange, mean = lfcThreshold,
+ sd = res$lfcSE, lower.tail = TRUE)
+ newStatBelow <- pmax(0, res$log2FoldChange + lfcThreshold) / res$lfcSE
+ pvalueBelow <- pnorm(res$log2FoldChange, mean = -lfcThreshold,
+ sd = res$lfcSE, lower.tail = FALSE)
+ newStat <- pmin(newStatAbove, newStatBelow)
+ newPvalue <- pmax(pvalueAbove, pvalueBelow)
+ } else if (altHypothesis == "greater") {
+ newStat <- pmax(0, res$log2FoldChange - lfcThreshold) / res$lfcSE
+ newPvalue <- pnorm(res$log2FoldChange, mean = lfcThreshold,
+ sd = res$lfcSE, lower.tail = FALSE)
+ } else if (altHypothesis == "less") {
+ newStat <- pmax(0, lfcThreshold - res$log2FoldChange) / res$lfcSE
+ newPvalue <- pnorm(res$log2FoldChange, mean = -lfcThreshold,
+ sd = res$lfcSE, lower.tail = TRUE)
+ }
+ res$stat <- newStat
+ res$pvalue <- newPvalue
+ }
+
+ # calculate Cook's cutoff
+ m <- nrow(attr(object,"dispModelMatrix"))
+ p <- ncol(attr(object,"dispModelMatrix"))
+
+ # only if more samples than parameters:
+ if (m > p) {
+ defaultCutoff <- qf(.99, p, m - p)
+ if (missing(cooksCutoff)) {
+ cooksCutoff <- defaultCutoff
+ }
+ stopifnot(length(cooksCutoff)==1)
+ if (is.logical(cooksCutoff) & cooksCutoff) {
+ cooksCutoff <- defaultCutoff
+ }
+ } else {
+ cooksCutoff <- FALSE
+ }
+
+ # apply cutoff based on maximum Cook's distance
+ performCooksCutoff <- (is.numeric(cooksCutoff) | cooksCutoff)
+ if ((m > p) & performCooksCutoff) {
+ cooksOutlier <- mcols(object)$maxCooks > cooksCutoff
+ res$pvalue[cooksOutlier] <- NA
+ }
+
+ # if original baseMean was positive, but now zero due to replaced counts, fill in results
+ if ( sum(mcols(object)$replace, na.rm=TRUE) > 0) {
+ nowZero <- which(mcols(object)$replace & mcols(object)$baseMean == 0)
+ res$log2FoldChange[nowZero] <- 0
+ if (addMLE) { res$lfcMLE[nowZero] <- 0 }
+ res$lfcSE[nowZero] <- 0
+ res$stat[nowZero] <- 0
+ res$pvalue[nowZero] <- 1
+ }
+
+ # p-value adjustment
+ paRes <- pvalueAdjustment(res, independentFiltering, filter, theta, alpha, pAdjustMethod, filterFun)
+ res$padj <- paRes$padj
+
+ # adding metadata columns for padj
+ mcols(res)$type[names(res)=="padj"] <- "results"
+ mcols(res)$description[names(res)=="padj"] <- paste(pAdjustMethod,"adjusted p-values")
+
+ # make results object
+ deseqRes <- DESeqResults(res)
+
+ # finalize object / add attributes / make GRanges
+ if (independentFiltering) {
+ metadata(deseqRes) <- list(filterThreshold=paRes$filterThreshold,
+ filterTheta=paRes$filterTheta,
+ filterNumRej=paRes$filterNumRej,
+ lo.fit=paRes$lo.fit,
+ alpha=alpha)
+ }
+
+ # remove rownames and attach as a new column, 'row'
+ if (tidy) {
+ colnms <- colnames(deseqRes)
+ deseqRes$row <- rownames(deseqRes)
+ mcols(deseqRes,use.names=TRUE)["row","type"] <- "results"
+ mcols(deseqRes,use.names=TRUE)["row","description"] <- "row names"
+ deseqRes <- deseqRes[,c("row",colnms)]
+ rownames(deseqRes) <- NULL
+ deseqRes <- as.data.frame(deseqRes)
+ }
+
+ if (format == "DataFrame") {
+ return(deseqRes)
+ } else if (format == "GRangesList") {
+ if (class(rowRanges(object)) == "GRanges") warning("rowRanges is GRanges")
+ out <- rowRanges(object)
+ mcols(out) <- deseqRes
+ return(out)
+ } else if (format == "GRanges") {
+ if (class(rowRanges(object)) == "GRangesList") {
+ warning("rowRanges is GRangesList, performing unlist(range(x)) on the rowRanges")
+ out <- unlist(range(rowRanges(object)))
+ mcols(out) <- deseqRes
+ return(out)
+ } else {
+ out <- rowRanges(object)
+ mcols(out) <- deseqRes
+ return(out)
+ }
+ }
+}
+
+#' @rdname results
+#' @export
+resultsNames <- function(object) {
+ names(mcols(object))[grep("log2 fold change",mcols(mcols(object))$description)]
+}
+
+#' @rdname results
+#' @export
+removeResults <- function(object) {
+ resCols <- mcols(mcols(object))$type == "results"
+ if (sum(resCols,na.rm=TRUE) > 0) {
+ mcols(object) <- mcols(object)[,-which(resCols),drop=FALSE]
+ }
+ return(object)
+}
+
+
+###########################################################
+# unexported functons
+###########################################################
+
+pvalueAdjustment <- function(res, independentFiltering, filter,
+ theta, alpha, pAdjustMethod,
+ filterFun) {
+ # perform independent filtering
+ if (independentFiltering) {
+ if (missing(filter)) {
+ filter <- res$baseMean
+ }
+ if (missing(theta)) {
+ lowerQuantile <- mean(filter == 0)
+ if (lowerQuantile < .95) upperQuantile <- .95 else upperQuantile <- 1
+ theta <- seq(lowerQuantile, upperQuantile, length=50)
+ }
+ if (missing(filterFun)) {
+ # do filtering using genefilter
+ stopifnot(length(theta) > 1)
+ stopifnot(length(filter) == nrow(res))
+ filtPadj <- filtered_p(filter=filter, test=res$pvalue,
+ theta=theta, method=pAdjustMethod)
+ numRej <- colSums(filtPadj < alpha, na.rm = TRUE)
+ # prevent over-aggressive filtering when all genes are null,
+ # by requiring the max number of rejections is above a fitted curve.
+ # If the max number of rejection is not greater than 10, then don't
+ # perform independent filtering at all.
+ lo.fit <- lowess(numRej ~ theta, f=1/5)
+ if (max(numRej) <= 10) {
+ j <- 1
+ } else {
+ residual <- if (all(numRej==0)) {
+ 0
+ } else {
+ numRej[numRej > 0] - lo.fit$y[numRej > 0]
+ }
+ thresh <- max(lo.fit$y) - sqrt(mean(residual^2))
+ j <- if (any(numRej > thresh)) {
+ which(numRej > thresh)[1]
+ } else {
+ 1
+ }
+ }
+ # j <- which.max(numRej) # old method
+ padj <- filtPadj[, j, drop=TRUE]
+ cutoffs <- quantile(filter, theta)
+ filterThreshold <- cutoffs[j]
+ filterNumRej <- data.frame(theta=theta, numRej=numRej)
+ filterTheta <- theta[j]
+ } else {
+ # use a custom filter function
+ padj <- filterFun(alpha=alpha,
+ filter=filter,
+ test=res$pvalue,
+ theta=theta,
+ method=pAdjustMethod)
+ filterThreshold <- NULL
+ filterTheta <- NULL
+ filterNumRej <- NULL
+ lo.fit <- NULL
+ }
+ return(list(padj=padj,
+ filterThreshold=filterThreshold,
+ filterTheta=filterTheta,
+ filterNumRej=filterNumRej,
+ lo.fit=lo.fit))
+ } else {
+ # regular p-value adjustment
+ # does not include those rows which were removed
+ # by maximum Cook's distance
+ padj <- p.adjust(res$pvalue,method=pAdjustMethod)
+ return(list(padj=padj))
+ }
+}
+
+
+
+# two low-level functions used by results() to perform contrasts
+#
+# getContrast takes a DESeqDataSet object
+# and a numeric vector specifying a contrast
+# and returns a vector of Wald statistics
+# corresponding to the contrast.
+#
+# cleanContrast checks for the validity of
+# the specified contrast (numeric or character vector)
+# and turns character vector contrast into the appropriate
+# numeric vector contrast
+#
+# results() calls cleanContrast() which calls getContrast()
+#
+# the formula used is:
+# c' beta / sqrt( c' sigma c)
+# where beta is the coefficient vector
+# and sigma is the covariance matrix for beta
+getContrast <- function(object, contrast, useT=FALSE, df) {
+ if (missing(contrast)) {
+ stop("must provide a contrast")
+ }
+ if (is.null(attr(object,"modelMatrix"))) {
+ stop("was expecting a model matrix stored as an attribute of the DESeqDataSet")
+ }
+ modelMatrix <- attr(object, "modelMatrix")
+
+ # only continue on the rows with non-zero row mean
+ objectNZ <- object[!mcols(object)$allZero,]
+ normalizationFactors <- if (!is.null(normalizationFactors(objectNZ))) {
+ normalizationFactors(objectNZ)
+ } else {
+ matrix(rep(sizeFactors(objectNZ),each=nrow(objectNZ)),
+ ncol=ncol(objectNZ))
+ }
+ alpha_hat <- dispersions(objectNZ)
+ coefColumns <- names(mcols(objectNZ))[grep("log2 fold change",mcols(mcols(object))$description)]
+ # convert betas to log scale
+ beta_mat <- log(2) * as.matrix(mcols(objectNZ)[,coefColumns,drop=FALSE])
+ # convert beta prior variance to log scale
+ lambda = 1/(log(2)^2 * attr(object,"betaPriorVar"))
+
+ # check if DESeq() replaced outliers
+ countsMatrix <- if ("replaceCounts" %in% assayNames(object)) {
+ assays(objectNZ)[["replaceCounts"]]
+ } else {
+ counts(objectNZ)
+ }
+
+ betaRes <- fitBeta(ySEXP = countsMatrix, xSEXP = modelMatrix,
+ nfSEXP = normalizationFactors,
+ alpha_hatSEXP = alpha_hat,
+ contrastSEXP = contrast,
+ beta_matSEXP = beta_mat,
+ lambdaSEXP = lambda,
+ tolSEXP = 1e-8, maxitSEXP = 0,
+ useQRSEXP=FALSE) # QR not relevant, fitting loop isn't entered
+ # convert back to log2 scale
+ contrastEstimate <- log2(exp(1)) * betaRes$contrast_num
+ contrastSE <- log2(exp(1)) * betaRes$contrast_denom
+ contrastStatistic <- contrastEstimate / contrastSE
+ if (useT) {
+ stopifnot(length(df)==1)
+ contrastPvalue <- 2*pt(abs(contrastStatistic),df=df,lower.tail=FALSE)
+ } else {
+ contrastPvalue <- 2*pnorm(abs(contrastStatistic),lower.tail=FALSE)
+ }
+ contrastList <- list(log2FoldChange=contrastEstimate,
+ lfcSE=contrastSE,
+ stat=contrastStatistic,
+ pvalue=contrastPvalue)
+ contrastResults <- buildDataFrameWithNARows(contrastList,
+ mcols(object)$allZero)
+ names(contrastResults) <- c("log2FoldChange","lfcSE","stat","pvalue")
+ contrastResults
+}
+
+# this function takes a desired contrast as specified by results(),
+# performs checks, and then either returns the already existing contrast
+# or generates the contrast by calling getContrast() using a numeric vector
+cleanContrast <- function(object, contrast, expanded=FALSE, listValues, test) {
+ # get the names of columns in the beta matrix
+ resNames <- resultsNames(object)
+ # if possible, return pre-computed columns, which are
+ # already stored in mcols(dds). this will be the case using
+ # results() with 'name', or if expanded model matrices were not
+ # run and the contrast contains the reference level as numerator or denominator
+
+ resReady <- FALSE
+
+ if (is.character(contrast)) {
+ contrastFactor <- contrast[1]
+ if (!contrastFactor %in% names(colData(object))) {
+ stop(paste(contrastFactor,"should be the name of a factor in the colData of the DESeqDataSet"))
+ }
+ contrastNumLevel <- contrast[2]
+ contrastDenomLevel <- contrast[3]
+ contrastBaseLevel <- levels(colData(object)[,contrastFactor])[1]
+
+ # check if both levels have all zero counts
+ contrastAllZero <- contrastAllZeroCharacter(object, contrastFactor, contrastNumLevel, contrastDenomLevel)
+
+ # check for intercept
+ hasIntercept <- attr(terms(design(object)),"intercept") == 1
+ firstVar <- contrastFactor == all.vars(design(object))[1]
+
+ # tricky case: if the design has no intercept, the factor is
+ # not the first variable in the design, and one of the numerator or denominator
+ # is the reference level, then the desired contrast is simply a coefficient (or -1 times)
+ noInterceptPullCoef <- !hasIntercept & !firstVar &
+ (contrastBaseLevel %in% c(contrastNumLevel, contrastDenomLevel))
+
+ # case 1: standard model matrices: pull coef or build the appropriate contrast
+ # coefficients names are of the form "factor_level_vs_baselevel"
+ # output: contrastNumColumn and contrastDenomColumn
+ if (!expanded & (hasIntercept | noInterceptPullCoef)) {
+ # use make.names() so the column names are
+ # the same as created by DataFrame in mcols(object).
+ contrastNumColumn <- make.names(paste0(contrastFactor,"_",contrastNumLevel,"_vs_",contrastBaseLevel))
+ contrastDenomColumn <- make.names(paste0(contrastFactor,"_",contrastDenomLevel,"_vs_",contrastBaseLevel))
+ # check that the desired contrast is already
+ # available in mcols(object), and then we can either
+ # take it directly or multiply the log fold
+ # changes and Wald stat by -1
+ if ( contrastDenomLevel == contrastBaseLevel ) {
+ cleanName <- paste(contrastFactor,contrastNumLevel,"vs",contrastDenomLevel)
+ # the results can be pulled directly from mcols(object)
+ name <- if (!noInterceptPullCoef) {
+ make.names(paste0(contrastFactor,"_",contrastNumLevel,"_vs_",contrastDenomLevel))
+ } else {
+ make.names(paste0(contrastFactor,contrastNumLevel))
+ }
+ if (!name %in% resNames) {
+ stop(paste("as",contrastDenomLevel,"is the reference level, was expecting",name,"to be present in 'resultsNames(object)'"))
+ }
+ log2FoldChange <- getCoef(object, name)
+ lfcSE <- getCoefSE(object, name)
+ stat <- getStat(object, test, name)
+ pvalue <- getPvalue(object, test, name)
+ res <- cbind(mcols(object)["baseMean"],log2FoldChange,lfcSE,stat,pvalue)
+ names(res) <- c("baseMean","log2FoldChange","lfcSE","stat","pvalue")
+ lfcType <- if (attr(object,"betaPrior")) "MAP" else "MLE"
+ lfcDesc <- paste0("log2 fold change (",lfcType,"): ",cleanName)
+ mcols(res,use.names=TRUE)["log2FoldChange","description"] <- lfcDesc
+ resReady <- TRUE
+
+ } else if ( contrastNumLevel == contrastBaseLevel ) {
+ # fetch the results for denom vs num
+ # and mutiply the log fold change and stat by -1
+ cleanName <- paste(contrastFactor,contrastNumLevel,"vs",contrastDenomLevel)
+ swapName <- if (!noInterceptPullCoef) {
+ make.names(paste0(contrastFactor,"_",contrastDenomLevel,"_vs_",contrastNumLevel))
+ } else {
+ make.names(paste0(contrastFactor,contrastDenomLevel))
+ }
+ if (!swapName %in% resNames) {
+ stop(paste("as",contrastNumLevel,"is the reference level, was expecting",swapName,"to be present in 'resultsNames(object)'"))
+ }
+ log2FoldChange <- getCoef(object, swapName)
+ lfcSE <- getCoefSE(object, swapName)
+ stat <- getStat(object, test, swapName)
+ pvalue <- getPvalue(object, test, swapName)
+ res <- cbind(mcols(object)["baseMean"],log2FoldChange,lfcSE,stat,pvalue)
+ names(res) <- c("baseMean","log2FoldChange","lfcSE","stat","pvalue")
+ res$log2FoldChange <- -1 * res$log2FoldChange
+ if (test == "Wald") res$stat <- -1 * res$stat
+ lfcType <- if (attr(object,"betaPrior")) "MAP" else "MLE"
+ # rename some of the columns using the flipped contrast
+ if (test == "Wald") {
+ contrastDescriptions <- paste(c(paste0("log2 fold change (",lfcType,"):"),
+ "standard error:",
+ "Wald statistic:","Wald test p-value:"), cleanName)
+ mcols(res,use.names=TRUE)[c("log2FoldChange","lfcSE","stat","pvalue"),
+ "description"] <- contrastDescriptions
+ } else {
+ contrastDescriptions <- paste(c(paste0("log2 fold change (",lfcType,"):"),
+ "standard error:"), cleanName)
+ mcols(res,use.names=TRUE)[c("log2FoldChange","lfcSE"),
+ "description"] <- contrastDescriptions
+ }
+ resReady <- TRUE
+
+ } else {
+ # check for the case where neither are present
+ # as comparisons against reference level
+ if ( ! (contrastNumColumn %in% resNames &
+ contrastDenomColumn %in% resNames) ) {
+ stop(paste(contrastNumLevel,"and",contrastDenomLevel,"should be levels of",contrastFactor,"such that",contrastNumColumn,"and",contrastDenomColumn,"are contained in 'resultsNames(object)'"))
+ }
+ }
+ # case 2: expanded model matrices or no intercept and first variable
+ # need to then build the appropriate contrast.
+ # these coefficient names have the form "factorlevel"
+ # output: contrastNumColumn and contrastDenomColumn
+ } else {
+ # we only need to check validity
+ contrastNumColumn <- make.names(paste0(contrastFactor, contrastNumLevel))
+ contrastDenomColumn <- make.names(paste0(contrastFactor, contrastDenomLevel))
+ if ( ! (contrastNumColumn %in% resNames & contrastDenomColumn %in% resNames) ) {
+ stop(paste(paste0(contrastFactor,contrastNumLevel),"and",paste0(contrastFactor,contrastDenomLevel),
+ "are expected to be in resultsNames(object)"))
+ }
+ }
+ }
+
+ # if the result table not already built in the above code...
+ if (!resReady) {
+
+ # here, a numeric / list / character contrast which will be converted
+ # into a numeric contrast and run through getContrast()
+ if (is.numeric(contrast)) {
+ # make name for numeric contrast
+ signMap <- c("","","+")
+ contrastSigns <- signMap[sign(contrast)+2]
+ contrastName <- paste(paste0(contrastSigns,as.character(contrast)),collapse=",")
+ } else if (is.list(contrast)) {
+ # interpret list contrast into numeric and make a name for the contrast
+ lc1 <- length(contrast[[1]])
+ lc2 <- length(contrast[[2]])
+ # these just used for naming
+ listvalname1 <- round(listValues[1],3)
+ listvalname2 <- round(listValues[2],3)
+ if (lc1 > 0 & lc2 > 0) {
+ listvalname2 <- abs(listvalname2)
+ listvalname1 <- if (listvalname1 == 1) "" else paste0(listvalname1," ")
+ listvalname2 <- if (listvalname2 == 1) "" else paste0(listvalname2," ")
+ contrastName <- paste0(listvalname1,paste(contrast[[1]],collapse="+")," vs ",listvalname2,paste(contrast[[2]],collapse="+"))
+ } else if (lc1 > 0 & lc2 == 0) {
+ listvalname1 <- if (listvalname1 == 1) "" else paste0(listvalname1," ")
+ contrastName <- paste0(listvalname1,paste(contrast[[1]],collapse="+")," effect")
+ } else if (lc1 == 0 & lc2 > 0) {
+ contrastName <- paste(listvalname2,paste(contrast[[2]],collapse="+"),"effect")
+ }
+ contrastNumeric <- rep(0,length(resNames))
+ contrastNumeric[resNames %in% contrast[[1]]] <- listValues[1]
+ contrastNumeric[resNames %in% contrast[[2]]] <- listValues[2]
+ contrast <- contrastNumeric
+ } else if (is.character(contrast)) {
+ # interpret character contrast into numeric and make a name for the contrast
+ contrastNumeric <- rep(0,length(resNames))
+ contrastNumeric[resNames == contrastNumColumn] <- 1
+ contrastNumeric[resNames == contrastDenomColumn] <- -1
+ contrast <- contrastNumeric
+ contrastName <- paste(contrastFactor,contrastNumLevel,"vs",contrastDenomLevel)
+ }
+
+ contrastAllZero <- contrastAllZeroNumeric(object, contrast)
+
+ # now get the contrast
+ contrastResults <- getContrast(object, contrast, useT=FALSE, df)
+ lfcType <- if (attr(object,"betaPrior")) "MAP" else "MLE"
+ contrastDescriptions <- paste(c(paste0("log2 fold change (",lfcType,"):"),
+ "standard error:",
+ "Wald statistic:",
+ "Wald test p-value:"),
+ contrastName)
+ mcols(contrastResults) <- DataFrame(type=rep("results",ncol(contrastResults)),
+ description=contrastDescriptions)
+ res <- cbind(mcols(object)["baseMean"],
+ contrastResults)
+
+ }
+
+ # if the counts in all samples included in contrast are zero
+ # then zero out the LFC, Wald stat and p-value set to 1
+ contrastAllZero <- contrastAllZero & !mcols(object)$allZero
+ if (sum(contrastAllZero) > 0) {
+ res$log2FoldChange[contrastAllZero] <- 0
+ res$stat[contrastAllZero] <- 0
+ res$pvalue[contrastAllZero] <- 1
+ }
+
+ # if test is "LRT", overwrite the statistic and p-value
+ # (we only ran contrast for the coefficient)
+ if (test == "LRT") {
+ stat <- getStat(object, test, name=NULL)
+ pvalue <- getPvalue(object, test, name=NULL)
+ res <- cbind(res[c("baseMean","log2FoldChange","lfcSE")],stat,pvalue)
+ names(res) <- c("baseMean","log2FoldChange","lfcSE","stat","pvalue")
+ }
+
+ return(res)
+}
+
+
+# convenience function to guess the name of the last coefficient
+# in the model matrix, unless specified this will be used for
+# plots and accessor functions
+lastCoefName <- function(object) {
+ resNms <- resultsNames(object)
+ resNms[length(resNms)]
+}
+
+# functions to get coef, coefSE, pvalues and padj from mcols(object)
+getCoef <- function(object,name) {
+ if (missing(name)) {
+ name <- lastCoefName(object)
+ }
+ mcols(object)[name]
+}
+getCoefSE <- function(object,name) {
+ if (missing(name)) {
+ name <- lastCoefName(object)
+ }
+ mcols(object)[paste0("SE_",name)]
+}
+getStat <- function(object,test="Wald",name) {
+ if (missing(name)) {
+ name <- lastCoefName(object)
+ }
+ if (test == "Wald") {
+ return(mcols(object)[paste0("WaldStatistic_",name)])
+ } else if (test == "LRT") {
+ return(mcols(object)["LRTStatistic"])
+ } else {
+ stop("unknown test")
+ }
+}
+getPvalue <- function(object,test="Wald",name) {
+ if (missing(name)) {
+ name <- lastCoefName(object)
+ }
+ if (test == "Wald") {
+ return(mcols(object)[paste0("WaldPvalue_",name)])
+ } else if (test == "LRT") {
+ return(mcols(object)["LRTPvalue"])
+ } else {
+ stop("unknown test")
+ }
+}
+
+# convenience function to make more descriptive names
+# for factor variables
+renameModelMatrixColumns <- function(data, design) {
+ data <- as.data.frame(data)
+ designVars <- all.vars(design)
+ designVarsClass <- sapply(designVars, function(v) class(data[[v]]))
+ factorVars <- designVars[designVarsClass == "factor"]
+ colNamesFrom <- make.names(do.call(c,lapply(factorVars, function(v) paste0(v,levels(data[[v]])[-1]))))
+ colNamesTo <- make.names(do.call(c,lapply(factorVars, function(v) paste0(v,"_",levels(data[[v]])[-1],"_vs_",levels(data[[v]])[1]))))
+ data.frame(from=colNamesFrom,to=colNamesTo,stringsAsFactors=FALSE)
+}
+
+makeWaldTest <- function(object) {
+ betaMatrix <- as.matrix(mcols(object)[,grep("log2 fold change",mcols(mcols(object))$description),drop=FALSE])
+ modelMatrixNames <- colnames(betaMatrix)
+ betaSE <- as.matrix(mcols(object)[,grep("standard error",mcols(mcols(object))$description),drop=FALSE])
+ WaldStatistic <- betaMatrix/betaSE
+ colnames(WaldStatistic) <- paste0("WaldStatistic_",modelMatrixNames)
+ WaldPvalue <- 2*pnorm(abs(WaldStatistic),lower.tail=FALSE)
+ colnames(WaldPvalue) <- paste0("WaldPvalue_",modelMatrixNames)
+ modelMatrixNamesSpaces <- gsub("_"," ",modelMatrixNames)
+ statInfo <- paste("Wald statistic:",modelMatrixNamesSpaces)
+ pvalInfo <- paste("Wald test p-value:",modelMatrixNamesSpaces)
+ WaldResults <- DataFrame(c(matrixToList(WaldStatistic), matrixToList(WaldPvalue)))
+ mcols(WaldResults) <- DataFrame(type = rep("results",ncol(WaldResults)),
+ description = c(statInfo, pvalInfo))
+ mcols(object) <- cbind(mcols(object),WaldResults)
+ return(object)
+}
+
+mleContrast <- function(object, contrast) {
+ contrastFactor <- contrast[1]
+ contrastNumLevel <- contrast[2]
+ contrastDenomLevel <- contrast[3]
+ contrastRefLevel <- levels(colData(object)[,contrastFactor])[1]
+ contrastNumColumn <- make.names(paste0("MLE_",contrastFactor,"_",contrastNumLevel,"_vs_",contrastRefLevel))
+ contrastDenomColumn <- make.names(paste0("MLE_",contrastFactor,"_",contrastDenomLevel,"_vs_",contrastRefLevel))
+ cleanName <- paste("log2 fold change (MLE):",contrastFactor,contrastNumLevel,"vs",contrastDenomLevel)
+ if ( contrastDenomLevel == contrastRefLevel ) {
+ name <- make.names(paste0("MLE_",contrastFactor,"_",contrastNumLevel,"_vs_",contrastDenomLevel))
+ lfcMLE <- mcols(object)[name]
+ } else if ( contrastNumLevel == contrastRefLevel ) {
+ swapName <- make.names(paste0("MLE_",contrastFactor,"_",contrastDenomLevel,"_vs_",contrastNumLevel))
+ lfcMLE <- mcols(object)[swapName]
+ lfcMLE[[1]] <- -1 * lfcMLE[[swapName]]
+ } else {
+ numMLE <- mcols(object)[[contrastNumColumn]]
+ denomMLE <- mcols(object)[[contrastDenomColumn]]
+ lfcMLE <- mcols(object)[contrastNumColumn]
+ lfcMLE[[1]] <- numMLE - denomMLE
+ }
+ names(lfcMLE) <- "lfcMLE"
+ mcols(lfcMLE)$description <- cleanName
+ lfcMLE
+}
+
+checkContrast <- function(contrast, resNames) {
+ if (!(is.numeric(contrast) | is.character(contrast) | is.list(contrast))) {
+ stop("'contrast' vector should be either a character vector of length 3,
+a list of length 2 containing character vectors,
+or a numeric vector, see the argument description in ?results")
+ }
+
+ # character
+ if (is.character(contrast)) {
+ if (length(contrast) != 3) {
+ stop("'contrast', as a character vector of length 3, should have the form:
+contrast = c('factorName','numeratorLevel','denominatorLevel'),
+see the manual page of ?results for more information")
+ }
+ if (contrast[2] == contrast[3]) {
+ stop(paste(contrast[2],"and",contrast[3],"should be different level names"))
+ }
+ }
+
+ # list
+ if (is.list(contrast)) {
+ if (length(contrast) == 1) {
+ contrast <- list(contrast[[1]], character())
+ }
+ if (length(contrast) != 2) {
+ stop("'contrast', as a list, should have length 2, or, if length 1,
+an empty vector will be added for the second element.
+see the manual page of ?results for more information")
+ }
+ if (!(is.character(contrast[[1]]) & is.character(contrast[[2]]))) {
+ stop("'contrast', as a list of length 2, should have character vectors as elements,
+see the manual page of ?results for more information")
+ }
+ if (!all(c(contrast[[1]],contrast[[2]]) %in% resNames)) {
+ stop("all elements of the contrast as a list of length 2 should be elements of 'resultsNames(object)'")
+ }
+ if (length(intersect(contrast[[1]], contrast[[2]])) > 0) {
+ stop("elements in the contrast list should only appear in the numerator (first element of contrast list)
+or the denominator (second element of contrast list), but not both")
+ }
+ if (length(c(contrast[[1]],contrast[[2]])) == 0) {
+ stop("one of the two elements in the list should be a character vector of non-zero length")
+ }
+ }
+
+ # numeric
+ if (is.numeric(contrast)) {
+ if (length(contrast) != length(resNames) )
+ stop("numeric contrast vector should have one element for every element of 'resultsNames(object)'")
+ if (all(contrast==0)) {
+ stop("numeric contrast vector cannot have all elements equal to 0")
+ }
+ }
+
+ return(contrast)
+}
+
+
+contrastAllZeroCharacter <- function(object, contrastFactor, contrastNumLevel, contrastDenomLevel) {
+ cts <- counts(object)
+ f <- colData(object)[[contrastFactor]]
+ cts.sub <- cts[ , f %in% c(contrastNumLevel, contrastDenomLevel), drop=FALSE ]
+ rowSums( cts.sub == 0 ) == ncol(cts.sub)
+}
+
+contrastAllZeroNumeric <- function(object, contrast) {
+ if (is.null(attr(object,"modelMatrix"))) {
+ stop("was expecting a model matrix stored as an attribute of the DESeqDataSet")
+ }
+ modelMatrix <- attr(object, "modelMatrix")
+ if (all(contrast >= 0) | all(contrast <= 0)) {
+ return( rep(FALSE, nrow(object)) )
+ }
+ contrastBinary <- ifelse(contrast == 0, 0, 1)
+ whichSamples <- ifelse(modelMatrix %*% contrastBinary == 0, 0, 1)
+ zeroTest <- counts(object) %*% whichSamples
+ zeroTest == 0
+}
diff --git a/R/rlog.R b/R/rlog.R
new file mode 100644
index 0000000..a01aaf1
--- /dev/null
+++ b/R/rlog.R
@@ -0,0 +1,291 @@
+#' Apply a 'regularized log' transformation
+#'
+#' This function transforms the count data to the log2 scale in a way
+#' which minimizes differences between samples for rows with small counts,
+#' and which normalizes with respect to library size.
+#' The rlog transformation produces a similar variance stabilizing effect as
+#' \code{\link{varianceStabilizingTransformation}},
+#' though \code{rlog} is more robust in the
+#' case when the size factors vary widely.
+#' The transformation is useful when checking for outliers
+#' or as input for machine learning techniques
+#' such as clustering or linear discriminant analysis.
+#' \code{rlog} takes as input a \code{\link{DESeqDataSet}} and returns a
+#' \code{\link{RangedSummarizedExperiment}} object.
+#'
+#' Note that neither rlog transformation nor the VST are used by the
+#' differential expression estimation in \code{\link{DESeq}}, which always
+#' occurs on the raw count data, through generalized linear modeling which
+#' incorporates knowledge of the variance-mean dependence. The rlog transformation
+#' and VST are offered as separate functionality which can be used for visualization,
+#' clustering or other machine learning tasks. See the transformation section of the
+#' vignette for more details.
+#'
+#' The transformation does not require that one has already estimated size factors
+#' and dispersions.
+#'
+#' The regularization is on the log fold changes of the count for each sample
+#' over an intercept, for each gene. As nearby count values for low counts genes
+#' are almost as likely as the observed count, the rlog shrinkage is greater for low counts.
+#' For high counts, the rlog shrinkage has a much weaker effect.
+#' The fitted dispersions are used rather than the MAP dispersions
+#' (so similar to the \code{\link{varianceStabilizingTransformation}}).
+#'
+#' The prior variance for the shrinkag of log fold changes is calculated as follows:
+#' a matrix is constructed of the logarithm of the counts plus a pseudocount of 0.5,
+#' the log of the row means is then subtracted, leaving an estimate of
+#' the log fold changes per sample over the fitted value using only an intercept.
+#' The prior variance is then calculated by matching the upper quantiles of the observed
+#' log fold change estimates with an upper quantile of the normal distribution.
+#' A GLM fit is then calculated using this prior. It is also possible to supply the variance of the prior.
+#' See the vignette for an example of the use and a comparison with \code{varianceStabilizingTransformation}.
+#'
+#' The transformed values, rlog(K), are equal to
+#' \eqn{rlog(K_{ij}) = \log_2(q_{ij}) = \beta_{i0} + \beta_{ij}}{rlog(K_ij) = log2(q_ij) = beta_i0 + beta_ij},
+#' with formula terms defined in \code{\link{DESeq}}.
+#'
+#' The parameters of the rlog transformation from a previous dataset
+#' can be frozen and reapplied to new samples. See the 'Data quality assessment'
+#' section of the vignette for strategies to see if new samples are
+#' sufficiently similar to previous datasets.
+#' The frozen rlog is accomplished by saving the dispersion function,
+#' beta prior variance and the intercept from a previous dataset,
+#' and running \code{rlog} with 'blind' set to FALSE
+#' (see example below).
+#'
+#' @aliases rlog rlogTransformation
+#' @rdname rlog
+#' @name rlog
+#'
+#' @param object a DESeqDataSet, or matrix of counts
+#' @param blind logical, whether to blind the transformation to the experimental
+#' design. blind=TRUE should be used for comparing samples in an manner unbiased by
+#' prior information on samples, for example to perform sample QA (quality assurance).
+#' blind=FALSE should be used for transforming data for downstream analysis,
+#' where the full use of the design information should be made.
+#' blind=FALSE will skip re-estimation of the dispersion trend, if this has already been calculated.
+#' If many of genes have large differences in counts due to
+#' the experimental design, it is important to set blind=FALSE for downstream
+#' analysis.
+#' @param intercept by default, this is not provided and calculated automatically.
+#' if provided, this should be a vector as long as the number of rows of object,
+#' which is log2 of the mean normalized counts from a previous dataset.
+#' this will enforce the intercept for the GLM, allowing for a "frozen" rlog
+#' transformation based on a previous dataset.
+#' You will also need to provide \code{mcols(object)$dispFit}.
+#' @param betaPriorVar a single value, the variance of the prior on the sample
+#' betas, which if missing is estimated from the data
+#' @param fitType in case dispersions have not yet been estimated for \code{object},
+#' this parameter is passed on to \code{\link{estimateDispersions}} (options described there).
+#'
+#' @return a \code{\link{DESeqTransform}} if a \code{DESeqDataSet} was provided,
+#' or a matrix if a count matrix was provided as input.
+#' Note that for \code{\link{DESeqTransform}} output, the matrix of
+#' transformed values is stored in \code{assay(rld)}.
+#' To avoid returning matrices with NA values, in the case of a row
+#' of all zeros, the rlog transformation returns zeros
+#' (essentially adding a pseudocount of 1 only to these rows).
+#'
+#' @references
+#'
+#' Reference for regularized logarithm (rlog):
+#'
+#' Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+#'
+#' @seealso \code{\link{plotPCA}}, \code{\link{varianceStabilizingTransformation}}, \code{\link{normTransform}}
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=6,betaSD=1)
+#' rld <- rlog(dds)
+#' dists <- dist(t(assay(rld)))
+#' plot(hclust(dists))
+#'
+#' # run the rlog transformation on one dataset
+#' design(dds) <- ~ 1
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#' rld <- rlog(dds, blind=FALSE)
+#'
+#' # apply the parameters to a new sample
+#'
+#' ddsNew <- makeExampleDESeqDataSet(m=1)
+#' mcols(ddsNew)$dispFit <- mcols(dds)$dispFit
+#' betaPriorVar <- attr(rld,"betaPriorVar")
+#' intercept <- mcols(rld)$rlogIntercept
+#' rldNew <- rlog(ddsNew, blind=FALSE,
+#' intercept=intercept,
+#' betaPriorVar=betaPriorVar)
+#'
+#'
+#' @export
+rlog <- function(object, blind=TRUE, intercept, betaPriorVar, fitType="parametric") {
+ if (is.null(colnames(object))) {
+ colnames(object) <- seq_len(ncol(object))
+ }
+ if (is.matrix(object)) {
+ matrixIn <- TRUE
+ object <- DESeqDataSetFromMatrix(object, DataFrame(row.names=colnames(object)), ~ 1)
+ } else {
+ matrixIn <- FALSE
+ }
+ if (is.null(sizeFactors(object)) & is.null(normalizationFactors(object))) {
+ object <- estimateSizeFactors(object)
+ }
+ if (blind) {
+ design(object) <- ~ 1
+ }
+ # sparsity test
+ if (missing(intercept)) {
+ sparseTest(counts(object, normalized=TRUE), .9, 100, .1)
+ }
+ if (blind | is.null(mcols(object)$dispFit)) {
+ # estimate the dispersions on all genes
+ if (is.null(mcols(object)$baseMean)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+ object <- estimateDispersionsGeneEst(object, quiet=TRUE)
+ object <- estimateDispersionsFit(object, fitType, quiet=TRUE)
+ }
+ if (!missing(intercept)) {
+ if (length(intercept) != nrow(object)) {
+ stop("intercept should be as long as the number of rows of object")
+ }
+ }
+ rld <- rlogData(object, intercept, betaPriorVar)
+ if (matrixIn) {
+ return(rld)
+ }
+ se <- SummarizedExperiment(
+ assays = rld,
+ colData = colData(object),
+ rowRanges = rowRanges(object),
+ metadata = metadata(object))
+ dt <- DESeqTransform(se)
+ attr(dt,"betaPriorVar") <- attr(rld, "betaPriorVar")
+ if (!is.null(attr(rld,"intercept"))) {
+ mcols(dt)$rlogIntercept <- attr(rld,"intercept")
+ }
+ dt
+}
+
+#' @rdname rlog
+#' @export
+rlogTransformation <- rlog
+
+###################### unexported
+
+rlogData <- function(object, intercept, betaPriorVar) {
+ if (is.null(mcols(object)$dispFit)) {
+ stop("first estimate dispersion")
+ }
+ samplesVector <- as.character(seq_len(ncol(object)))
+ if (!missing(intercept)) {
+ if (length(intercept) != nrow(object)) {
+ stop("intercept should be as long as the number of rows of object")
+ }
+ }
+ if (is.null(mcols(object)$allZero) | is.null(mcols(object)$baseMean)) {
+ object <- getBaseMeansAndVariances(object)
+ }
+
+ # make a design matrix with a term for every sample
+ # this would typically produce unidentifiable solution
+ # for the GLM, but we add priors for all terms except
+ # the intercept
+ samplesVector <- factor(samplesVector,levels=unique(samplesVector))
+ if (missing(intercept)) {
+ samples <- factor(c("null_level",as.character(samplesVector)),
+ levels=c("null_level",levels(samplesVector)))
+ modelMatrix <- model.matrix(~samples)[-1,]
+ modelMatrixNames <- colnames(modelMatrix)
+ modelMatrixNames[modelMatrixNames == "(Intercept)"] <- "Intercept"
+ } else {
+ # or we want to set the intercept using the
+ # provided intercept instead
+ samples <- factor(samplesVector)
+ if (length(samples) > 1) {
+ modelMatrix <- model.matrix(~ 0 + samples)
+ } else {
+ modelMatrix <- matrix(1,ncol=1)
+ modelMatrixNames <- "samples1"
+ }
+ modelMatrixNames <- colnames(modelMatrix)
+ if (!is.null(normalizationFactors(object))) {
+ nf <- normalizationFactors(object)
+ } else {
+ sf <- sizeFactors(object)
+ nf <- matrix(rep(sf,each=nrow(object)),ncol=ncol(object))
+ }
+ # if the intercept is not finite, these rows
+ # were all zero. here we put a small value instead
+ intercept <- as.numeric(intercept)
+ infiniteIntercept <- !is.finite(intercept)
+ intercept[infiniteIntercept] <- -10
+ normalizationFactors(object) <- nf * 2^intercept
+ # we set the intercept, so replace the all zero
+ # column with the rows which were all zero
+ # in the previous dataset
+ mcols(object)$allZero <- infiniteIntercept
+ }
+
+ # only continue on the rows with non-zero row sums
+ objectNZ <- object[!mcols(object)$allZero,]
+ stopifnot(all(!is.na(mcols(objectNZ)$dispFit)))
+
+ # if a prior sigma squared not provided, estimate this
+ # by the matching upper quantiles of the
+ # log2 counts plus a pseudocount
+ if (missing(betaPriorVar)) {
+ logCounts <- log2(counts(objectNZ,normalized=TRUE) + 0.5)
+ logFoldChangeMatrix <- logCounts - log2(mcols(objectNZ)$baseMean + 0.5)
+ logFoldChangeVector <- as.numeric(logFoldChangeMatrix)
+ varlogk <- 1/mcols(objectNZ)$baseMean + mcols(objectNZ)$dispFit
+ weights <- 1/varlogk
+ betaPriorVar <- matchWeightedUpperQuantileForVariance(logFoldChangeVector, rep(weights,ncol(objectNZ)))
+ }
+ stopifnot(length(betaPriorVar)==1)
+
+ lambda <- 1/rep(betaPriorVar,ncol(modelMatrix))
+ # except for intercept which we set to wide prior
+ if ("Intercept" %in% modelMatrixNames) {
+ lambda[which(modelMatrixNames == "Intercept")] <- 1e-6
+ }
+
+ fit <- fitNbinomGLMs(object=objectNZ, modelMatrix=modelMatrix,
+ lambda=lambda, renameCols=FALSE,
+ alpha_hat=mcols(objectNZ)$dispFit,
+ betaTol=1e-4, useOptim=FALSE,
+ useQR=TRUE)
+ normalizedDataNZ <- t(modelMatrix %*% t(fit$betaMatrix))
+
+ normalizedData <- buildMatrixWithZeroRows(normalizedDataNZ, mcols(object)$allZero)
+
+ # add back in the intercept, if finite
+ if (!missing(intercept)) {
+ normalizedData <- normalizedData + ifelse(infiniteIntercept, 0, intercept)
+ }
+ colnames(normalizedData) <- colnames(object)
+ attr(normalizedData,"betaPriorVar") <- betaPriorVar
+ if ("Intercept" %in% modelMatrixNames) {
+ fittedInterceptNZ <- fit$betaMatrix[,which(modelMatrixNames == "Intercept"),drop=FALSE]
+ fittedIntercept <- buildMatrixWithNARows(fittedInterceptNZ, mcols(object)$allZero)
+ fittedIntercept[is.na(fittedIntercept)] <- -Inf
+ attr(normalizedData,"intercept") <- fittedIntercept
+ }
+ normalizedData
+}
+
+sparseTest <- function(x, p, t1, t2) {
+ rs <- rowSums(x)
+ rmx <- apply(x, 1, max)
+ if (all(rs <= t1)) return(invisible())
+ prop <- (rmx/rs)[rs > t1]
+ total <- mean(prop > p)
+ if (total > t2) warning("the rlog assumes that data is close to a negative binomial distribution, an assumption
+which is sometimes not compatible with datasets where many genes have many zero counts
+despite a few very large counts.
+In this data, for ",round(total,3)*100,"% of genes with a sum of normalized counts above ",t1,", it was the case
+that a single sample's normalized count made up more than ",p*100,"% of the sum over all samples.
+the threshold for this warning is ",t2*100,"% of genes. See plotSparsity(dds) for a visualization of this.
+We recommend instead using the varianceStabilizingTransformation or shifted log (see vignette).")
+}
diff --git a/R/vst.R b/R/vst.R
new file mode 100644
index 0000000..706bf25
--- /dev/null
+++ b/R/vst.R
@@ -0,0 +1,203 @@
+#' Apply a variance stabilizing transformation (VST) to the count data
+#'
+#' This function calculates a variance stabilizing transformation (VST) from the
+#' fitted dispersion-mean relation(s) and then transforms the count data (normalized
+#' by division by the size factors or normalization factors), yielding a matrix
+#' of values which are now approximately homoskedastic (having constant variance along the range
+#' of mean values). The transformation also normalizes with respect to library size.
+#' The \code{\link{rlog}} is less sensitive
+#' to size factors, which can be an issue when size factors vary widely.
+#' These transformations are useful when checking for outliers or as input for
+#' machine learning techniques such as clustering or linear discriminant analysis.
+#'
+#' @aliases varianceStabilizingTransformation getVarianceStabilizedData
+#'
+#' @param object a DESeqDataSet or matrix of counts
+#' @param blind logical, whether to blind the transformation to the experimental
+#' design. blind=TRUE should be used for comparing samples in an manner unbiased by
+#' prior information on samples, for example to perform sample QA (quality assurance).
+#' blind=FALSE should be used for transforming data for downstream analysis,
+#' where the full use of the design information should be made.
+#' blind=FALSE will skip re-estimation of the dispersion trend, if this has already been calculated.
+#' If many of genes have large differences in counts due to
+#' the experimental design, it is important to set blind=FALSE for downstream
+#' analysis.
+#' @param fitType in case dispersions have not yet been estimated for \code{object},
+#' this parameter is passed on to \code{\link{estimateDispersions}} (options described there).
+#'
+#' @details For each sample (i.e., column of \code{counts(dds)}), the full variance function
+#' is calculated from the raw variance (by scaling according to the size factor and adding
+#' the shot noise). We recommend a blind estimation of the variance function, i.e.,
+#' one ignoring conditions. This is performed by default, and can be modified using the
+#' 'blind' argument.
+#'
+#' Note that neither rlog transformation nor the VST are used by the
+#' differential expression estimation in \code{\link{DESeq}}, which always
+#' occurs on the raw count data, through generalized linear modeling which
+#' incorporates knowledge of the variance-mean dependence. The rlog transformation
+#' and VST are offered as separate functionality which can be used for visualization,
+#' clustering or other machine learning tasks. See the transformation section of the
+#' vignette for more details.
+#'
+#' The transformation does not require that one has already estimated size factors
+#' and dispersions.
+#'
+#' A typical workflow is shown in Section \emph{Variance stabilizing transformation}
+#' in the package vignette.
+#'
+#' If \code{\link{estimateDispersions}} was called with:
+#'
+#' \code{fitType="parametric"},
+#' a closed-form expression for the variance stabilizing
+#' transformation is used on the normalized
+#' count data. The expression can be found in the file \file{vst.pdf}
+#' which is distributed with the vignette.
+#'
+#' \code{fitType="local"},
+#' the reciprocal of the square root of the variance of the normalized counts, as derived
+#' from the dispersion fit, is then numerically
+#' integrated, and the integral (approximated by a spline function) is evaluated for each
+#' count value in the column, yielding a transformed value.
+#'
+#' \code{fitType="mean"}, a VST is applied for Negative Binomial distributed counts, 'k',
+#' with a fixed dispersion, 'a': ( 2 asinh(sqrt(a k)) - log(a) - log(4) )/log(2).
+#'
+#' In all cases, the transformation is scaled such that for large
+#' counts, it becomes asymptotically (for large values) equal to the
+#' logarithm to base 2 of normalized counts.
+#'
+#' The variance stabilizing transformation from a previous dataset
+#' can be frozen and reapplied to new samples. See the 'Data quality assessment'
+#' section of the vignette for strategies to see if new samples are
+#' sufficiently similar to previous datasets.
+#' The frozen VST is accomplished by saving the dispersion function
+#' accessible with \code{\link{dispersionFunction}}, assigning this
+#' to the \code{DESeqDataSet} with the new samples, and running
+#' varianceStabilizingTransformation with 'blind' set to FALSE
+#' (see example below).
+#' Then the dispersion function from the previous dataset will be used
+#' to transform the new sample(s).
+#'
+#' Limitations: In order to preserve normalization, the same
+#' transformation has to be used for all samples. This results in the
+#' variance stabilizition to be only approximate. The more the size
+#' factors differ, the more residual dependence of the variance on the
+#' mean will be found in the transformed data. \code{\link{rlog}} is a
+#' transformation which can perform better in these cases.
+#' As shown in the vignette, the function \code{meanSdPlot}
+#' from the package \pkg{vsn} can be used to see whether this is a problem.
+#'
+#' @return \code{varianceStabilizingTransformation} returns a
+#' \code{\link{DESeqTransform}} if a \code{DESeqDataSet} was provided,
+#' or returns a a matrix if a count matrix was provided.
+#' Note that for \code{\link{DESeqTransform}} output, the matrix of
+#' transformed values is stored in \code{assay(vsd)}.
+#' \code{getVarianceStabilizedData} also returns a matrix.
+#'
+#' @references
+#'
+#' Reference for the variance stabilizing transformation for counts with a dispersion trend:
+#'
+#' Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+#'
+#' @author Simon Anders
+#'
+#' @seealso \code{\link{plotPCA}}, \code{\link{rlog}}, \code{\link{normTransform}}
+#'
+#' @examples
+#'
+#' dds <- makeExampleDESeqDataSet(m=6)
+#' vsd <- varianceStabilizingTransformation(dds)
+#' dists <- dist(t(assay(vsd)))
+#' plot(hclust(dists))
+#'
+#' # learn the dispersion function of a dataset
+#' design(dds) <- ~ 1
+#' dds <- estimateSizeFactors(dds)
+#' dds <- estimateDispersions(dds)
+#'
+#' # use the previous dispersion function for a new sample
+#' ddsNew <- makeExampleDESeqDataSet(m=1)
+#' ddsNew <- estimateSizeFactors(ddsNew)
+#' dispersionFunction(ddsNew) <- dispersionFunction(dds)
+#' vsdNew <- varianceStabilizingTransformation(ddsNew, blind=FALSE)
+#'
+#' @export
+varianceStabilizingTransformation <- function (object, blind=TRUE, fitType="parametric") {
+ if (is.null(colnames(object))) {
+ colnames(object) <- seq_len(ncol(object))
+ }
+ if (is.matrix(object)) {
+ matrixIn <- TRUE
+ object <- DESeqDataSetFromMatrix(object, DataFrame(row.names=colnames(object)), ~ 1)
+ } else {
+ matrixIn <- FALSE
+ }
+ if (is.null(sizeFactors(object)) & is.null(normalizationFactors(object))) {
+ object <- estimateSizeFactors(object)
+ }
+ if (blind) {
+ design(object) <- ~ 1
+ }
+ if (blind | is.null(attr(dispersionFunction(object),"fitType"))) {
+ object <- estimateDispersionsGeneEst(object, quiet=TRUE)
+ object <- estimateDispersionsFit(object, quiet=TRUE, fitType)
+ }
+ vsd <- getVarianceStabilizedData(object)
+ if (matrixIn) {
+ return(vsd)
+ }
+ se <- SummarizedExperiment(
+ assays = vsd,
+ colData = colData(object),
+ rowRanges = rowRanges(object),
+ metadata = metadata(object))
+ DESeqTransform(se)
+}
+
+#' @rdname varianceStabilizingTransformation
+#' @export
+getVarianceStabilizedData <- function(object) {
+ if (is.null(attr(dispersionFunction(object),"fitType"))) {
+ stop("call estimateDispersions before calling getVarianceStabilizedData")
+ }
+ ncounts <- counts(object, normalized=TRUE)
+ if( attr( dispersionFunction(object), "fitType" ) == "parametric" ) {
+ coefs <- attr( dispersionFunction(object), "coefficients" )
+ vst <- function( q ) {
+ log( (1 + coefs["extraPois"] + 2 * coefs["asymptDisp"] * q + 2 * sqrt( coefs["asymptDisp"] * q * ( 1 + coefs["extraPois"] + coefs["asymptDisp"] * q ) ) ) / ( 4 * coefs["asymptDisp"] ) ) / log(2)
+ }
+ return(vst(ncounts))
+ } else if ( attr( dispersionFunction(object), "fitType" ) == "local" ) {
+ # non-parametric fit -> numerical integration
+ if (is.null(sizeFactors(object))) {
+ stop("call estimateSizeFactors before calling getVarianceStabilizedData if using local dispersion fit")
+ }
+ xg <- sinh( seq( asinh(0), asinh(max(ncounts)), length.out=1000 ) )[-1]
+ xim <- mean( 1/sizeFactors(object) )
+ baseVarsAtGrid <- dispersionFunction(object)( xg ) * xg^2 + xim * xg
+ integrand <- 1 / sqrt( baseVarsAtGrid )
+ splf <- splinefun(
+ asinh( ( xg[-1] + xg[-length(xg)] )/2 ),
+ cumsum(
+ ( xg[-1] - xg[-length(xg)] ) *
+ ( integrand[-1] + integrand[-length(integrand)] )/2 ) )
+ h1 <- quantile( rowMeans(ncounts), .95 )
+ h2 <- quantile( rowMeans(ncounts), .999 )
+ eta <- ( log2(h2) - log2(h1) ) / ( splf(asinh(h2)) - splf(asinh(h1)) )
+ xi <- log2(h1) - eta * splf(asinh(h1))
+ tc <- sapply( colnames(counts(object)), function(clm) {
+ eta * splf( asinh( ncounts[,clm] ) ) + xi
+ })
+ rownames( tc ) <- rownames( counts(object) )
+ return(tc)
+ } else if ( attr( dispersionFunction(object), "fitType" ) == "mean" ) {
+ alpha <- attr( dispersionFunction(object), "mean" )
+ # the following stablizes NB counts with fixed dispersion alpha
+ # and converges to log2(q) as q => infinity
+ vst <- function(q) ( 2 * asinh(sqrt(alpha * q)) - log(alpha) - log(4) ) / log(2)
+ return(vst(ncounts))
+ } else {
+ stop( "fitType is not parametric, local or mean" )
+ }
+}
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..c6d055f
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/inst/CITATION b/inst/CITATION
new file mode 100644
index 0000000..856126d
--- /dev/null
+++ b/inst/CITATION
@@ -0,0 +1,15 @@
+citEntry(entry="article",
+ title = "Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2",
+ author = personList( as.person("Michael I Love"),
+ as.person("Wolfgang Huber"),
+ as.person("Simon Anders")),
+ year = 2014,
+ journal = "Genome Biology",
+ doi = "10.1186/s13059-014-0550-8",
+ volume = 15,
+ issue = 12,
+ pages = 550,
+ textVersion =
+ paste("Michael I Love, Wolfgang Huber and Simon Anders (2014):",
+ "Moderated estimation of fold change and dispersion for RNA-Seq data with DESeq2.",
+ "Genome Biology" ) )
diff --git a/inst/doc/DESeq2.Rnw b/inst/doc/DESeq2.Rnw
new file mode 100644
index 0000000..78543b6
--- /dev/null
+++ b/inst/doc/DESeq2.Rnw
@@ -0,0 +1,2161 @@
+%\VignetteIndexEntry{Analyzing RNA-seq data with the "DESeq2" package}
+%\VignettePackage{DESeq2}
+%\VignetteEngine{knitr::knitr}
+
+% To compile this document
+% library('knitr'); rm(list=ls()); knit('DESeq2.Rnw')
+
+\documentclass[11pt]{article}
+
+\newcommand{\deseqtwo}{\textit{DESeq2}}
+\newcommand{\lowtilde}{\raise.17ex\hbox{$\scriptstyle\mathtt{\sim}$}}
+
+<<knitr, echo=FALSE, results="hide">>=
+library("knitr")
+opts_chunk$set(
+ tidy=FALSE,
+ dev="png",
+ fig.show="hide",
+ fig.width=4, fig.height=4.5,
+ cache=TRUE,
+ message=FALSE)
+@
+
+<<style, eval=TRUE, echo=FALSE, results="asis">>=
+BiocStyle::latex()
+@
+
+<<loadDESeq2, echo=FALSE>>=
+library("DESeq2")
+@
+
+
+\author{Michael I. Love$^{1}$, Simon Anders$^{2,3}$, Wolfgang Huber$^{3}$ \\[1em]
+ \small{$^{1}$ Department of Biostatistics, Dana-Farber Cancer Institute and} \\
+ \small{Harvard TH Chan School of Public Health, Boston, US;} \\
+ \small{$^{2}$ Institute for Molecular Medicine Finland (FIMM), Helsinki, Finland;} \\
+ \small{$^{3}$ European Molecular Biology Laboratory (EMBL), Heidelberg, Germany} }
+
+\title{Differential analysis of count data -- the DESeq2 package}
+
+\begin{document}
+
+\maketitle
+
+\begin{abstract}
+ A basic task in the analysis of count data from RNA-seq is the detection of
+ differentially expressed genes. The count data are presented as a table which reports,
+ for each sample, the number of sequence fragments that have been assigned to each
+ gene. Analogous data also arise for other assay types, including comparative ChIP-Seq,
+ HiC, shRNA screening, mass spectrometry. An important analysis question is the
+ quantification and statistical inference of systematic changes between conditions, as
+ compared to within-condition variability. The package \deseqtwo{} provides
+ methods to test for differential expression by use of negative binomial generalized
+ linear models; the estimates of dispersion and logarithmic fold changes
+ incorporate data-driven prior distributions\footnote{Other \Bioconductor{} packages
+ with similar aims are \Biocpkg{edgeR}, \Biocpkg{limma},
+ \Biocpkg{DSS}, \Biocpkg{EBSeq} and \Biocpkg{baySeq}.}.
+ This vignette explains the use of the package and demonstrates typical workflows.
+ An RNA-seq workflow\footnote{\url{http://www.bioconductor.org/help/workflows/rnaseqGene/}}
+ on the Bioconductor website covers similar material to this vignette
+ but at a slower pace, including the generation of count matrices
+ from FASTQ files.
+
+ \vspace{1em}
+
+ \textbf{DESeq2 version:} \Sexpr{packageVersion("DESeq2")}
+
+ \vspace{1em}
+
+ \begin{center}
+ \begin{tabular}{ | l | }
+ \hline
+ If you use \deseqtwo{} in published research, please cite: \\
+ \\
+ M. I. Love, W. Huber, S. Anders: \textbf{Moderated estimation of} \\
+ \textbf{fold change and dispersion for RNA-seq data with DESeq2}. \\
+ \emph{Genome Biology} 2014, \textbf{15}:550. \\
+ \url{http://dx.doi.org/10.1186/s13059-014-0550-8} \\
+ \hline
+ \end{tabular}
+ \end{center}
+
+\end{abstract}
+
+<<options, results="hide", echo=FALSE>>=
+options(digits=3, width=80, prompt=" ", continue=" ")
+@
+
+\newpage
+
+\tableofcontents
+
+\newpage
+
+\section{Standard workflow}
+
+\subsection{Quick start}
+
+Here we show the most basic steps for a differential expression analysis.
+These steps require you have a \Rclass{RangedSummarizedExperiment} object
+\Robject{se} which contains the counts and information about samples.
+The \Robject{design} indicates that we want to
+measure the effect of condition, controlling for batch differences.
+The two factor variables \Robject{batch} and \Robject{condition}
+should be columns of \Robject{colData(se)}.
+
+<<quick, eval=FALSE>>=
+dds <- DESeqDataSet(se, design = ~ batch + condition)
+dds <- DESeq(dds)
+res <- results(dds, contrast=c("condition","trt","con"))
+@
+
+If you have a count matrix and sample information table, the first
+line would use \Rfunction{DESeqDataSetFromMatrix} instead of
+\Rfunction{DESeqDataSet}, as shown in Section~\ref{sec:countmat}.
+
+\subsection{How to get help}
+
+All \deseqtwo{} questions should be posted to the Bioconductor support
+site: \url{https://support.bioconductor.org}, which serves as a
+repository of questions and answers. See the first question in the
+list of Frequently Asked Questions (Section \ref{sec:faq})
+for more information about how to construct an informative post.
+
+\subsection{Input data} \label{sec:prep}
+
+\subsubsection{Why raw counts?}
+
+As input, the \deseqtwo{} package expects count data as obtained, e.\,g.,
+from RNA-seq or another high-throughput sequencing experiment, in the form of a
+matrix of integer values. The value in the $i$-th row and the $j$-th column of
+the matrix tells how many reads have been mapped to gene $i$ in sample $j$.
+Analogously, for other types of assays, the rows of the matrix might correspond
+e.\,g.\ to binding regions (with ChIP-Seq) or peptide sequences (with
+quantitative mass spectrometry). We will list method for obtaining count tables
+in a section below.
+
+The count values must be raw counts of sequencing reads (for
+single-end RNA-seq) or fragments (for paired-end RNA-seq).
+The \href{http://www.bioconductor.org/help/workflows/rnaseqGene/}{RNA-seq workflow}
+describes multiple techniques for preparing such count matrices.
+It is important to provide count matrices as input for \deseqtwo{}'s
+statistical model \cite{Love2014} to hold, as only the
+count values allow assessing the measurement precision correctly. The \deseqtwo{}
+model internally corrects for library size, so transformed values such as counts
+scaled by library size should never be used as input.
+
+\subsubsection{\Rclass{SummarizedExperiment} input} \label{sec:sumExpInput}
+
+The class used by the \deseqtwo{} package to store the read counts
+is \Rclass{DESeqDataSet} which extends the \Rclass{RangedSummarizedExperiment}
+class of the \Biocpkg{SummarizedExperiment} package.
+This facilitates preparation steps and also downstream exploration of results.
+For counting aligned reads in genes, the \Rfunction{summarizeOverlaps} function of
+\Biocpkg{GenomicAlignments} with \Robject{mode="Union"} is
+encouraged, resulting in a \Rclass{RangedSummarizedExperiment} object.
+Other methods for obtaining count matrices are described in the next section.
+
+An example of the steps to produce a \Rclass{RangedSummarizedExperiment} can
+be found in an RNA-seq workflow on the Bioconductor
+website: \url{http://www.bioconductor.org/help/workflows/rnaseqGene/}
+and in the vignette for the data package \Biocexptpkg{airway}.
+Here we load the \Rclass{RangedSummarizedExperiment} from that package in
+order to build a \Rclass{DESeqDataSet}.
+
+<<loadSumExp>>=
+library("airway")
+data("airway")
+se <- airway
+@
+
+A \Rclass{DESeqDataSet} object must have an associated design formula.
+The design formula expresses the variables which will be
+used in modeling. The formula should be a tilde ($\sim$) followed by the
+variables with plus signs between them (it will be coerced into an
+\Rclass{formula} if it is not already). An intercept is included,
+representing the base mean of counts. The design can be changed later,
+however then all differential analysis steps should be repeated,
+as the design formula is used to estimate the dispersions and
+to estimate the log2 fold changes of the model.
+The constructor function below shows the generation of a
+\Rclass{DESeqDataSet} from a \Rclass{RangedSummarizedExperiment} \Robject{se}.
+
+\emph{Note}: In order to benefit from the default settings of the
+package, you should put the variable of interest at the end of the
+formula and make sure the control level is the first level.
+
+<<sumExpInput>>=
+library("DESeq2")
+ddsSE <- DESeqDataSet(se, design = ~ cell + dex)
+ddsSE
+@
+
+\subsubsection{Count matrix input} \label{sec:countmat}
+
+Alternatively, the function \Rfunction{DESeqDataSetFromMatrix} can be
+used if you already have a matrix of read counts prepared from another
+source. Another method for quickly producing count matrices
+from alignment files is the \Rfunction{featureCounts} function
+in the \Biocpkg{Rsubread} package.
+To use \Rfunction{DESeqDataSetFromMatrix}, the user should provide
+the counts matrix, the information about the samples (the columns of the
+count matrix) as a \Rclass{DataFrame} or \Rclass{data.frame},
+and the design formula.
+
+To demonstate the use of \Rfunction{DESeqDataSetFromMatrix},
+we will first load the \Robject{pasillaGenes}
+data object, pull out the count matrix which we will name \Robject{countData},
+and sample information, \Robject{colData}. Below we describe how to extract
+these objects from, e.g. \Rfunction{featureCounts} output.
+
+<<loadPasilla>>=
+library("pasilla")
+library("Biobase")
+data("pasillaGenes")
+countData <- counts(pasillaGenes)
+colData <- pData(pasillaGenes)[,c("condition","type")]
+@
+
+The count matrix and column data:
+
+<<showPasilla>>=
+head(countData)
+head(colData)
+@
+
+If you have used the \Rfunction{featureCounts} function in the
+\Biocpkg{Rsubread} package, the matrix of read counts can be directly
+provided from the \Robject{"counts"} element in the list output.
+The count matrix and column data can also be read into R
+from flat files using base R functions such as \Rfunction{read.csv}
+or \Rfunction{read.delim}.
+For \textit{HTSeq} count files, see the dedicated input function below.
+
+With the count matrix, \Robject{countData}, and the sample
+information, \Robject{colData}, we can construct a \Rclass{DESeqDataSet}:
+
+<<matrixInput>>=
+dds <- DESeqDataSetFromMatrix(countData = countData,
+ colData = colData,
+ design = ~ condition)
+dds
+@
+
+If you have additional feature data, it can be added to the
+\Rclass{DESeqDataSet} by adding to the metadata columns of a newly
+constructed object. (Here we add redundant data just for demonstration, as
+the gene names are already the rownames of the \Robject{dds}.)
+
+<<addFeatureData>>=
+featureData <- data.frame(gene=rownames(pasillaGenes))
+(mcols(dds) <- DataFrame(mcols(dds), featureData))
+@
+
+\subsubsection{\textit{HTSeq} input}
+
+You can use the function \Rfunction{DESeqDataSetFromHTSeqCount} if you
+have \texttt{htseq-count} from the \textit{HTSeq} python
+package\footnote{available from \url{http://www-huber.embl.de/users/anders/HTSeq}, described in \cite{Anders:2014:htseq}}.
+For an example of using the python scripts, see the
+\Biocexptpkg{pasilla} data package. First you will want to specify a
+variable which points to the directory in which the \textit{HTSeq}
+output files are located.
+
+<<htseqDirI, eval=FALSE>>=
+directory <- "/path/to/your/files/"
+@
+
+However, for demonstration purposes only, the following line of
+code points to the directory for the demo \textit{HTSeq} output
+files packages for the \Biocexptpkg{pasilla} package.
+
+<<htseqDirII>>=
+directory <- system.file("extdata", package="pasilla", mustWork=TRUE)
+@
+
+We specify which files to read in using \Rfunction{list.files},
+and select those files which contain the string \Robject{"treated"}
+using \Rfunction{grep}. The \Rfunction{sub} function is used to
+chop up the sample filename to obtain the condition status, or
+you might alternatively read in a phenotypic table
+using \Rfunction{read.table}.
+
+<<htseqInput>>=
+sampleFiles <- grep("treated",list.files(directory),value=TRUE)
+sampleCondition <- sub("(.*treated).*","\\1",sampleFiles)
+sampleTable <- data.frame(sampleName = sampleFiles,
+ fileName = sampleFiles,
+ condition = sampleCondition)
+ddsHTSeq <- DESeqDataSetFromHTSeqCount(sampleTable = sampleTable,
+ directory = directory,
+ design= ~ condition)
+ddsHTSeq
+@
+
+\subsubsection{Pre-filtering}
+
+While it is not necessary to pre-filter low count genes before running the \deseqtwo{}
+functions, there are two reasons which make pre-filtering useful:
+by removing rows in which there are no reads or nearly no reads,
+we reduce the memory size of the \Robject{dds} data object and
+we increase the speed of the transformation
+and testing functions within \deseqtwo{}. Here we perform a minimal
+pre-filtering to remove rows that have only 0 or 1 read. Note that more strict
+filtering to increase power is \textit{automatically} applied via independent filtering
+on the mean of normalized counts within the \Rfunction{results}
+function, which will be discussed in Section~\ref{sec:autoFilt}.
+
+<<prefilter>>=
+dds <- dds[ rowSums(counts(dds)) > 1, ]
+@
+
+\subsubsection{Note on factor levels} \label{sec:factorLevels}
+
+By default, R will choose a \textit{reference level} for factors based
+on alphabetical order. Then, if you never tell the \deseqtwo{} 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 \Rfunction{results} which comparison to make using the
+\Robject{contrast} argument (this will be shown later), or you can
+explicitly set the factors levels. Setting the factor levels can be done in two ways,
+either using factor:
+
+<<factorlvl>>=
+dds$condition <- factor(dds$condition, levels=c("untreated","treated"))
+@
+
+...or using \Rfunction{relevel}, just specifying the reference level:
+
+<<relevel>>=
+dds$condition <- relevel(dds$condition, ref="untreated")
+@
+
+If you need to subset the columns of a \Rclass{DESeqDataSet},
+i.e., when removing certain samples from the analysis, it is possible
+that all the samples for one or more levels of a variable in the design
+formula would be removed. In this case, the \Rfunction{droplevels} function can be used
+to remove those levels which do not have samples in the current \Rclass{DESeqDataSet}:
+
+<<droplevels>>=
+dds$condition <- droplevels(dds$condition)
+@
+
+\subsubsection{Collapsing technical replicates}
+
+\deseqtwo{} provides a function \Rfunction{collapseReplicates} which can
+assist in combining the counts from technical replicates into single
+columns. See the manual page for an example of the use of
+\Rfunction{collapseReplicates}.
+
+\subsubsection{About the pasilla dataset}
+
+We continue with the \Biocexptpkg{pasilla} data constructed from the
+count matrix method above. This data set is from an experiment on
+\emph{Drosophila melanogaster} cell cultures and investigated the
+effect of RNAi knock-down of the splicing factor \emph{pasilla}
+\cite{Brooks2010}. The detailed transcript of the production of
+the \Biocexptpkg{pasilla} data is provided in the vignette of the
+data package \Biocexptpkg{pasilla}.
+
+\subsection{Differential expression analysis} \label{sec:de}
+
+The standard differential expression analysis steps are wrapped
+into a single function, \Rfunction{DESeq}. The estimation steps performed
+by this function are described in Section~\ref{sec:glm}, in the manual page for
+\Robject{?DESeq} and in the Methods section of the \deseqtwo{} publication \cite{Love2014}.
+The individual sub-functions which are called by \Rfunction{DESeq}
+are still available, described in Section~\ref{sec:steps}.
+
+Results tables are generated using the function \Rfunction{results}, which
+extracts a results table with log2 fold changes, $p$ values and adjusted
+$p$ values. With no arguments to \Rfunction{results}, the results will be for
+the last variable in the design formula, and if this is a factor,
+the comparison will be the last level of this variable over the first level.
+Details about the comparison are printed to the console. The text, \texttt{condition}
+\texttt{treated vs untreated}, tells you that the estimates are of the logarithmic
+fold change $\log_2 ( \textrm{treated} / \textrm{untreated} )$.
+
+<<deseq>>=
+dds <- DESeq(dds)
+res <- results(dds)
+res
+@
+
+These steps should take less than 30 seconds for most analyses. For
+experiments with many samples (e.g. 100 samples), one can take
+advantage of parallelized computation. Both of the above functions
+have an argument \Robject{parallel} which if set to \Robject{TRUE} can
+be used to distribute computation across cores specified by the
+\Rfunction{register} function of \Biocpkg{BiocParallel}. For example,
+the following chunk (not evaluated here), would register 4 cores, and
+then the two functions above, with \Robject{parallel=TRUE}, would
+split computation over these cores.
+
+<<parallel, eval=FALSE>>=
+library("BiocParallel")
+register(MulticoreParam(4))
+@
+
+We can order our results table by the smallest adjusted $p$ value:
+
+<<resOrder>>=
+resOrdered <- res[order(res$padj),]
+@
+
+We can summarize some basic tallies using the
+\Rfunction{summary} function.
+
+<<sumRes>>=
+summary(res)
+@
+
+How many adjusted p-values were less than 0.1?
+
+<<sumRes01>>=
+sum(res$padj < 0.1, na.rm=TRUE)
+@
+
+The \Rfunction{results} function contains a number of arguments to
+customize the results table which is generated. Note that the
+\Rfunction{results} function automatically performs independent
+filtering based on the mean of normalized counts for each gene,
+optimizing the number of genes which will have an adjusted $p$ value
+below a given FDR cutoff, \Robject{alpha}.
+Independent filtering is further discussed in Section~\ref{sec:autoFilt}.
+By default the argument
+\Robject{alpha} is set to $0.1$. If the adjusted $p$ value cutoff
+will be a value other than $0.1$, \Robject{alpha} should be set to
+that value:
+
+<<resAlpha05>>=
+res05 <- results(dds, alpha=0.05)
+summary(res05)
+sum(res05$padj < 0.05, na.rm=TRUE)
+@
+
+
+If a multi-factor design is used, or if the variable in the design
+formula has more than two levels, the \Robject{contrast} argument of
+\Rfunction{results} can be used to extract different comparisons from
+the \Rclass{DESeqDataSet} returned by \Rfunction{DESeq}.
+Multi-factor designs are discussed further in Section~\ref{sec:multifactor},
+and the use of the \Robject{contrast} argument is dicussed in Section~\ref{sec:contrasts}.
+
+For advanced users, note that all the values calculated by the \deseqtwo{}
+package are stored in the \Rclass{DESeqDataSet} object, and access
+to these values is discussed in Section~\ref{sec:access}.
+
+\subsection{Exploring and exporting results}
+
+\subsubsection{MA-plot}
+
+\begin{figure}
+\centering
+\includegraphics[width=.45\textwidth]{figure/MANoPrior-1}
+\includegraphics[width=.45\textwidth]{figure/MA-1}
+\caption{
+ \textbf{MA-plot.}
+ These plots show the log2 fold changes from the treatment over
+ the mean of normalized counts, i.e. the average of counts normalized by
+ size factors. The left plot shows the ``unshrunken'' log2 fold changes,
+ while the right plot, produced by the code above, shows the shrinkage
+ of log2 fold changes resulting from the incorporation of zero-centered
+ normal prior. The shrinkage is greater for the log2 fold change
+ estimates from genes with low counts and high dispersion,
+ as can be seen by the narrowing of spread of leftmost points
+ in the right plot.}
+\label{fig:MA}
+\end{figure}
+
+In \deseqtwo{}, the function \Rfunction{plotMA} shows the log2
+fold changes attributable to a given variable over the mean of normalized counts.
+Points will be colored red if the adjusted $p$ value is less than 0.1.
+Points which fall out of the window are plotted as open triangles pointing
+either up or down.
+
+<<MA, fig.width=4.5, fig.height=4.5>>=
+plotMA(res, main="DESeq2", ylim=c(-2,2))
+@
+
+After calling \Rfunction{plotMA}, one can use the function
+\Rfunction{identify} to interactively detect the row number of
+individual genes by clicking on the plot. One can then recover
+the gene identifiers by saving the resulting indices:
+
+<<MAidentify, eval=FALSE>>=
+idx <- identify(res$baseMean, res$log2FoldChange)
+rownames(res)[idx]
+@
+
+The MA-plot of log2 fold changes returned by \deseqtwo{} allows us to
+see how the shrinkage of fold changes works for genes with low
+counts. You can still obtain results tables which include the
+``unshrunken'' log2 fold changes (for a simple comparison, the ratio
+of the mean normalized counts in the two groups). A column
+\Robject{lfcMLE} with the unshrunken maximum likelihood estimate (MLE)
+for the log2 fold change will be added with an additional argument to
+\Rfunction{results}:
+
+<<resMLE>>=
+resMLE <- results(dds, addMLE=TRUE)
+head(resMLE, 4)
+@
+
+One can make an MA-plot of the unshrunken estimates like so:
+
+<<MANoPrior, fig.width=4.5, fig.height=4.5>>=
+plotMA(resMLE, MLE=TRUE, main="unshrunken LFC", ylim=c(-2,2))
+@
+
+\subsubsection{Plot counts} \label{sec:plotcounts}
+
+It can also be useful to examine the counts of reads for a single gene
+across the groups. A simple function for making this
+plot is \Rfunction{plotCounts}, which normalizes counts by sequencing depth
+and adds a pseudocount of $\frac{1}{2}$ to allow for log scale plotting.
+The counts are grouped by the variables in \Robject{intgroup}, where
+more than one variable can be specified. Here we specify the gene
+which had the smallest $p$ value from the results table created
+above. You can select the gene to plot by rowname or by numeric index.
+
+<<plotCounts, dev="pdf", fig.width=4.5, fig.height=5>>=
+plotCounts(dds, gene=which.min(res$padj), intgroup="condition")
+@
+
+For customized plotting, an argument \Robject{returnData} specifies
+that the function should only return a \Rclass{data.frame} for
+plotting with \Rfunction{ggplot}.
+
+<<plotCountsAdv, dev="pdf", fig.width=3.5, fig.height=3.5>>=
+d <- plotCounts(dds, gene=which.min(res$padj), intgroup="condition",
+ returnData=TRUE)
+library("ggplot2")
+ggplot(d, aes(x=condition, y=count)) +
+ geom_point(position=position_jitter(w=0.1,h=0)) +
+ scale_y_log10(breaks=c(25,100,400))
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.45\textwidth]{figure/plotCounts-1}
+\includegraphics[width=.45\textwidth]{figure/plotCountsAdv-1}
+\caption{
+ \textbf{Plot of counts for one gene.}
+ The plot of normalized counts (plus a pseudocount of $\frac{1}{2}$)
+ either made using the \Rfunction{plotCounts} function (left)
+ or using another plotting library (right, using \CRANpkg{ggplot2}).}
+\label{fig:plotcounts}
+\end{figure}
+
+\subsubsection{More information on results columns} \label{sec:moreInfo}
+
+Information about which variables and tests were used can be found by calling
+the function \Rfunction{mcols} on the results object.
+
+<<metadata>>=
+mcols(res)$description
+@
+
+For a particular gene, a log2 fold change of $-1$ for
+\Robject{condition treated vs untreated} means that the treatment
+induces a multiplicative change in observed gene expression level of
+$2^{-1} = 0.5$ compared to the untreated condition. If the variable of
+interest is continuous-valued, then the reported log2 fold change is
+per unit of change of that variable.
+
+\textbf{Note on p-values set to NA}: some values in the results table
+can be set to \Robject{NA} for one of the following reasons:
+
+\begin{enumerate}
+ \item If within a row, all samples have zero counts,
+ the \Robject{baseMean} column will be zero, and the
+ log2 fold change estimates, $p$ value and adjusted $p$ value
+ will all be set to \texttt{NA}.
+ \item If a row contains a sample with an extreme count outlier
+ then the $p$ value and adjusted $p$ value will be set to \texttt{NA}.
+ These outlier counts are detected by Cook's distance. Customization
+ of this outlier filtering and description of functionality for
+ replacement of outlier counts and refitting is described in
+ Section~\ref{sec:outlierApproach},
+ \item If a row is filtered by automatic independent filtering,
+ for having a low mean normalized count, then only the adjusted $p$
+ value will be set to \texttt{NA}.
+ Description and customization of independent filtering is
+ described in Section~\ref{sec:autoFilt}.
+\end{enumerate}
+
+\subsubsection{Exporting results to HTML or CSV files}
+An HTML report of the results with plots and sortable/filterable columns
+can be exported using the \Biocpkg{ReportingTools} package
+on a \Rclass{DESeqDataSet} that has been processed by the \Rfunction{DESeq} function.
+For a code example, see the ``RNA-seq differential expression'' vignette at
+the \Biocpkg{ReportingTools} page, or the manual page for the
+\Rfunction{publish} method for the \Rclass{DESeqDataSet} class.
+
+A plain-text file of the results can be exported using the
+base \R{} functions \Rfunction{write.csv} or \Rfunction{write.delim}.
+We suggest using a descriptive file name indicating the variable
+and levels which were tested.
+
+<<export, eval=FALSE>>=
+write.csv(as.data.frame(resOrdered),
+ file="condition_treated_results.csv")
+@
+
+Exporting only the results which pass an adjusted $p$ value
+threshold can be accomplished with the \Rfunction{subset} function,
+followed by the \Rfunction{write.csv} function.
+
+<<subset>>=
+resSig <- subset(resOrdered, padj < 0.1)
+resSig
+@
+
+\subsection{Multi-factor designs} \label{sec:multifactor}
+
+Experiments with more than one factor influencing the counts can be
+analyzed using design formula that include the additional variables.
+By adding these to the design, one can control for additional variation
+in the counts. For example, if the condition samples are balanced
+across experimental batches, by including the \Robject{batch} factor to the
+design, one can increase the sensitivity for finding differences due
+to \Robject{condition}. There are multiple ways to analyze experiments when the
+additional variables are of interest and not just controlling factors
+(see Section \ref{sec:interactions} on interactions).
+
+The data in the \Biocexptpkg{pasilla} package have a condition of interest
+(the column \Robject{condition}), as well as information on the type of sequencing
+which was performed (the column \Robject{type}), as we can see below:
+
+<<multifactor>>=
+colData(dds)
+@
+
+We create a copy of the \Rclass{DESeqDataSet}, so that we can rerun
+the analysis using a multi-factor design.
+
+<<copyMultifactor>>=
+ddsMF <- dds
+@
+
+We can account for the different types of sequencing, and get a clearer picture
+of the differences attributable to the treatment. As \Robject{condition} is the
+variable of interest, we put it at the end of the formula. Thus the \Rfunction{results}
+function will by default pull the \Robject{condition} results unless
+\Robject{contrast} or \Robject{name} arguments are specified.
+Then we can re-run \Rfunction{DESeq}:
+
+<<replaceDesign>>=
+design(ddsMF) <- formula(~ type + condition)
+ddsMF <- DESeq(ddsMF)
+@
+
+Again, we access the results using the \Rfunction{results} function.
+
+<<multiResults>>=
+resMF <- results(ddsMF)
+head(resMF)
+@
+
+It is also possible to retrieve the log2 fold changes, $p$ values and adjusted
+$p$ values of the \Robject{type} variable. The \Robject{contrast} argument of
+the function \Rfunction{results} takes a character vector of length three:
+the name of the variable, the name of the factor level for the numerator
+of the log2 ratio, and the name of the factor level for the denominator.
+The \Robject{contrast} argument can also take other forms, as
+described in the help page for \Rfunction{results} and in Section~\ref{sec:contrasts}.
+
+<<multiTypeResults>>=
+resMFType <- results(ddsMF, contrast=c("type","single-read","paired-end"))
+head(resMFType)
+@
+
+If the variable is continuous or an interaction term (see Section~\ref{sec:interactions})
+then the results can be extracted using the \Robject{name} argument to \Rfunction{results},
+where the name is one of elements returned by \Robject{resultsNames(dds)}.
+
+\newpage
+
+%---------------------------------------------------
+\section{Data transformations and visualization} \label{sec:transf}
+%---------------------------------------------------
+\subsection{Count data transformations}
+%---------------------------------------------------
+
+In order to test for differential expression, we operate on raw counts
+and use discrete distributions as described in the previous Section~\ref{sec:de}.
+However for other downstream analyses --
+e.g. for visualization or clustering -- it might be useful
+to work with transformed versions of the count data.
+
+Maybe the most obvious choice of transformation is the logarithm.
+Since count values for a gene can be zero in some
+conditions (and non-zero in others), some advocate the use of
+\emph{pseudocounts}, i.\,e.\ transformations of the form
+
+\begin{equation}\label{eq:shiftedlog}
+ y = \log_2(n + 1)\quad\mbox{or more generally,}\quad y = \log_2(n + n_0),
+\end{equation}
+
+where $n$ represents the count values and $n_0$ is a positive constant.
+
+In this section, we discuss two alternative
+approaches that offer more theoretical justification and a rational way
+of choosing the parameter equivalent to $n_0$ above.
+The \emph{regularized logarithm} or \emph{rlog} incorporates a prior on
+the sample differences \cite{Love2014},
+and the other uses the concept of variance stabilizing
+transformations (VST) \cite{Tibshirani1988,sagmb2003,Anders:2010:GB}.
+Both transformations produce transformed data on the $\log_2$ scale
+which has been normalized with respect to library size.
+
+The point of these two transformations, the \emph{rlog} and the VST,
+is to remove the dependence of the variance on the mean,
+particularly the high variance of the logarithm of count data when the
+mean is low. Both \emph{rlog} and VST use the experiment-wide trend
+of variance over mean, in order to transform the data to remove the
+experiment-wide trend. Note that we do not require or
+desire that all the genes have \emph{exactly} the same variance after
+transformation. Indeed, in Figure~\ref{fig:meansd} below, you will see
+that after the transformations the genes with the same mean do not
+have exactly the same standard deviations, but that the
+experiment-wide trend has flattened. It is those genes with row
+variance above the trend which will allow us to cluster samples into
+interesting groups.
+
+\textbf{Note on running time:} if you have many samples (e.g. 100s),
+the \Rfunction{rlog} function might take too long, and the variance
+stabilizing transformation might be a better choice. The rlog and VST
+have similar properties, but the rlog requires fitting a shrinkage
+term for each sample and each gene which takes time. See the
+\deseqtwo{} paper for more discussion on the differences
+\cite{Love2014}.
+
+\subsubsection{Blind dispersion estimation}
+
+The two functions, \Rfunction{rlog} and
+\Rfunction{varianceStabilizingTransformation}, have an argument
+\Robject{blind}, for whether the transformation should be blind to the
+sample information specified by the design formula. When
+\Robject{blind} equals \Robject{TRUE} (the default), the functions
+will re-estimate the dispersions using only an intercept (design
+formula $\sim 1$). This setting should be used in order to compare
+samples in a manner wholly unbiased by the information about
+experimental groups, for example to perform sample QA (quality
+assurance) as demonstrated below.
+
+However, blind dispersion estimation is not the appropriate choice if
+one expects that many or the majority of genes (rows) will have large
+differences in counts which are explainable by the experimental design,
+and one wishes to tranform the data for downstream analysis. In this
+case, using blind dispersion estimation will lead to large estimates
+of dispersion, as it attributes differences due to experimental design
+as unwanted ``noise'', and will result in overly shrinking the transformed
+values towards each other.
+By setting \Robject{blind} to \Robject{FALSE}, the dispersions
+already estimated will be used to perform transformations, or if not
+present, they will be estimated using the current design formula. Note
+that only the fitted dispersion estimates from mean-dispersion trend
+line are used in the transformation (the global dependence of
+dispersion on mean for the entire experiment).
+So setting \Robject{blind} to \Robject{FALSE} is still for the most
+part unbiased by the information about which samples were in which
+experimental group.
+
+\subsubsection{Extracting transformed values}
+
+The two functions return an object of class \Rclass{DESeqTransform}
+which is a subclass of \Rclass{RangedSummarizedExperiment}.
+The \Rfunction{assay} function is used to extract the matrix of normalized values:
+
+<<rlogAndVST>>=
+rld <- rlog(dds)
+vsd <- varianceStabilizingTransformation(dds)
+head(assay(rld), 3)
+@
+
+\subsubsection{Regularized log transformation}
+
+The function \Rfunction{rlog}, stands for \emph{regularized log},
+transforming the original count data to the log2 scale by fitting a
+model with a term for each sample and a prior distribution on the
+coefficients which is estimated from the data. This is the same kind
+of shrinkage (sometimes referred to as regularization, or moderation)
+of log fold changes used by the \Rfunction{DESeq} and
+\Rfunction{nbinomWaldTest}, as seen in Figure \ref{fig:MA}. The
+resulting data contains elements defined as:
+
+$$ \log_2(q_{ij}) = \beta_{i0} + \beta_{ij} $$
+
+where $q_{ij}$ is a parameter proportional to the expected true
+concentration of fragments for gene $i$ and sample $j$ (see
+Section~\ref{sec:glm}), $\beta_{i0}$ is an intercept which does not
+undergo shrinkage, and $\beta_{ij}$ is the sample-specific effect
+which is shrunk toward zero based on the dispersion-mean trend over
+the entire dataset. The trend typically captures high dispersions for
+low counts, and therefore these genes exhibit higher shrinkage from
+the\Rfunction{rlog}.
+
+Note that, as $q_{ij}$ represents the part of the mean value
+$\mu_{ij}$ after the size factor $s_j$ has been divided out, it is
+clear that the rlog transformation inherently accounts for differences
+in sequencing depth. Without priors, this design matrix would lead to
+a non-unique solution, however the addition of a prior on
+non-intercept betas allows for a unique solution to be found. The
+regularized log transformation is preferable to the variance
+stabilizing transformation if the size factors vary widely.
+
+\subsubsection{Variance stabilizing transformation}
+
+Above, we used a parametric fit for the dispersion. In this case, the
+closed-form expression for the variance stabilizing transformation is
+used by \Rfunction{varianceStabilizingTransformation}, which is
+derived in the file \texttt{vst.pdf}, that is distributed in the
+package alongside this vignette. If a local fit is used (option
+\Robject{fitType="locfit"} to \Rfunction{estimateDispersions}) a
+numerical integration is used instead.
+
+The resulting variance stabilizing transformation is shown in Figure
+\ref{figure/vsd1-1}. The code that produces the figure is hidden from
+this vignette for the sake of brevity, but can be seen in the
+\texttt{.Rnw} or \texttt{.R} source file. Note that the vertical axis
+in such plots is the square root of the variance over all samples, so
+including the variance due to the experimental conditions. While a
+flat curve of the square root of variance over the mean may seem like
+the goal of such transformations, this may be unreasonable in the case
+of datasets with many true differences due to the experimental
+conditions.
+
+<<vsd1, echo=FALSE, fig.width=4.5, fig.height=4.5>>=
+px <- counts(dds)[,1] / sizeFactors(dds)[1]
+ord <- order(px)
+ord <- ord[px[ord] < 150]
+ord <- ord[seq(1, length(ord), length=50)]
+last <- ord[length(ord)]
+vstcol <- c("blue", "black")
+matplot(px[ord],
+ cbind(assay(vsd)[, 1], log2(px))[ord, ],
+ type="l", lty=1, col=vstcol, xlab="n", ylab="f(n)")
+legend("bottomright",
+ legend = c(
+ expression("variance stabilizing transformation"),
+ expression(log[2](n/s[1]))),
+ fill=vstcol)
+@
+
+\incfig{figure/vsd1-1}{.49\textwidth}{VST and log2.}{
+ Graphs of the variance stabilizing transformation for
+ sample 1, in blue, and of the transformation $f(n) = \log_2(n/s_1)$, in
+ black. $n$ are the counts and $s_1$ is the size factor for the first sample.
+}
+
+\subsubsection{Effects of transformations on the variance}
+
+\begin{figure}
+\centering
+\includegraphics[width=.32\textwidth]{figure/log2meansd-1}
+\includegraphics[width=.32\textwidth]{figure/rlogmeansd-1}
+\includegraphics[width=.32\textwidth]{figure/vstmeansd-1}
+\caption{Per-gene standard deviation (taken across samples), against the rank
+ of the mean, for the shifted logarithm $\log_2(n+1)$ (left), the
+ regularized log transformation (center) and the variance stabilizing
+ transformation (right).}
+\label{fig:meansd}
+\end{figure}
+
+Figure~\ref{fig:meansd} plots the standard deviation of the transformed
+data, across samples, against the mean, using the shifted
+logarithm transformation (\ref{eq:shiftedlog}), the
+regularized log transformation and the variance stabilizing transformation.
+The shifted logarithm has elevated standard deviation in the lower
+count range, and the regularized log to a lesser extent, while for
+the variance stabilized data the standard deviation is roughly constant
+along the whole dynamic range.
+
+<<log2meansd, fig.width=4, fig.height=3>>=
+library("vsn")
+notAllZero <- (rowSums(counts(dds))>0)
+meanSdPlot(log2(counts(dds,normalized=TRUE)[notAllZero,] + 1))
+@
+
+<<rlogmeansd, fig.width=4, fig.height=3>>=
+meanSdPlot(assay(rld[notAllZero,]))
+@
+
+<<vstmeansd, fig.width=4, fig.height=3>>=
+meanSdPlot(assay(vsd[notAllZero,]))
+@
+
+
+%---------------------------------------------------------------
+\subsection{Data quality assessment by sample clustering and visualization}\label{sec:quality}
+%---------------------------------------------------------------
+
+Data quality assessment and quality control (i.\,e.\ the removal of
+insufficiently good data) are essential steps of any data
+analysis. These steps should typically be performed
+very early in the analysis of a new data set,
+preceding or in parallel to the differential expression testing.
+
+We define the term \emph{quality} as
+\emph{fitness for purpose}\footnote{\url{http://en.wikipedia.org/wiki/Quality_\%28business\%29}}.
+Our purpose is the detection of differentially expressed genes, and we
+are looking in particular for samples whose experimental treatment
+suffered from an anormality that renders the data points obtained from
+these particular samples detrimental to our purpose.
+
+\subsubsection{Heatmap of the count matrix}\label{sec:hmc}
+To explore a count matrix, it is often instructive to look at it as a
+heatmap. Below we show how to produce such a heatmap
+for various transformations of the data.
+
+<<heatmap>>=
+library("pheatmap")
+select <- order(rowMeans(counts(dds,normalized=TRUE)),decreasing=TRUE)[1:20]
+@
+
+<<figHeatmap2a, dev="pdf", fig.width=5, fig.height=7>>=
+nt <- normTransform(dds) # defaults to log2(x+1)
+log2.norm.counts <- assay(nt)[select,]
+df <- as.data.frame(colData(dds)[,c("condition","type")])
+pheatmap(log2.norm.counts, cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+<<figHeatmap2b, dev="pdf", fig.width=5, fig.height=7>>=
+pheatmap(assay(rld)[select,], cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+<<figHeatmap2c, dev="pdf", fig.width=5, fig.height=7>>=
+pheatmap(assay(vsd)[select,], cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2a-1}
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2b-1}
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2c-1}
+\caption{Heatmaps showing the expression data of the \Sexpr{length(select)}
+ most highly expressed genes. The data is of log2 normalized counts (left),
+ from regularized log transformation (center) and from variance
+ stabilizing transformation (right).}
+\label{fig:heatmap2}
+\end{figure}
+
+\incfig{figure/figHeatmapSamples-1}{.6\textwidth}{Sample-to-sample distances.}{
+ Heatmap showing the Euclidean distances between the samples
+ as calculated from the regularized log transformation.
+}
+
+\subsubsection{Heatmap of the sample-to-sample distances}\label{sec:dists}
+
+Another use of the transformed data is sample clustering. Here, we apply the
+\Rfunction{dist} function to the transpose of the transformed count matrix to get
+sample-to-sample distances. We could alternatively use the variance stabilized
+transformation here.
+
+<<sampleClust>>=
+sampleDists <- dist(t(assay(rld)))
+@
+
+A heatmap of this distance matrix gives us an overview over similarities
+and dissimilarities between samples (Figure \ref{figure/figHeatmapSamples-1}):
+We have to provide a hierarchical clustering \Robject{hc} to the heatmap
+function based on the sample distances, or else the heatmap
+function would calculate a clustering based on the distances between
+the rows/columns of the distance matrix.
+
+<<figHeatmapSamples, dev="pdf", fig.width=7, fig.height=7>>=
+library("RColorBrewer")
+sampleDistMatrix <- as.matrix(sampleDists)
+rownames(sampleDistMatrix) <- paste(rld$condition, rld$type, sep="-")
+colnames(sampleDistMatrix) <- NULL
+colors <- colorRampPalette( rev(brewer.pal(9, "Blues")) )(255)
+pheatmap(sampleDistMatrix,
+ clustering_distance_rows=sampleDists,
+ clustering_distance_cols=sampleDists,
+ col=colors)
+@
+
+\subsubsection{Principal component plot of the samples}\label{sec:pca}
+
+Related to the distance matrix of Section~\ref{sec:dists} is the PCA
+plot of the samples, which we obtain as follows (Figure \ref{figure/figPCA-1}).
+
+<<figPCA, dev="pdf", fig.width=5, fig.height=3>>=
+plotPCA(rld, intgroup=c("condition", "type"))
+@
+
+\incfig{figure/figPCA-1}{.7\textwidth}{PCA plot.}{
+ PCA plot. The \Sexpr{ncol(rld)} samples shown in the 2D
+ plane spanned by their first two principal components. This type of
+ plot is useful for visualizing the overall effect of experimental
+ covariates and batch effects.
+}
+
+It is also possible to customize the PCA plot using the
+\Rfunction{ggplot} function.
+
+<<figPCA2, dev="pdf", fig.width=5, fig.height=3>>=
+data <- plotPCA(rld, intgroup=c("condition", "type"), returnData=TRUE)
+percentVar <- round(100 * attr(data, "percentVar"))
+ggplot(data, aes(PC1, PC2, color=condition, shape=type)) +
+ geom_point(size=3) +
+ xlab(paste0("PC1: ",percentVar[1],"% variance")) +
+ ylab(paste0("PC2: ",percentVar[2],"% variance"))
+@
+
+\incfig{figure/figPCA2-1}{.7\textwidth}{PCA plot.}{
+ PCA plot customized using the \CRANpkg{ggplot2} library.
+}
+
+
+\newpage
+
+%--------------------------------------------------
+\section{Variations to the standard workflow}
+%--------------------------------------------------
+
+\subsection{Wald test individual steps} \label{sec:steps}
+
+The function \Rfunction{DESeq} runs the following functions in order:
+
+<<WaldTest, eval=FALSE>>=
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+dds <- nbinomWaldTest(dds)
+@
+
+\subsection{Contrasts} \label{sec:contrasts}
+
+A contrast is a linear combination of estimated log2 fold changes,
+which can be used to test if differences between groups are equal to
+zero. The simplest use case for contrasts is an experimental design
+containing a factor with three levels, say A, B and C. Contrasts
+enable the user to generate results for all 3 possible differences:
+log2 fold change of B vs A, of C vs A, and of C vs B.
+The \Robject{contrast} argument of \Rfunction{results} function is
+used to extract test results of log2 fold changes of interest, for example:
+
+<<simpleContrast, eval=FALSE>>=
+results(dds, contrast=c("condition","C","B"))
+@
+
+Log2 fold changes can also be added and subtracted by providing a
+\Robject{list} to the \Robject{contrast} argument which has two elements:
+the names of the log2 fold changes to add, and the names of the log2
+fold changes to subtract. The names used in the list should come from
+\Robject{resultsNames(dds)}.
+
+Alternatively, a numeric vector of the
+length of \Robject{resultsNames(dds)} can be provided, for manually
+specifying the linear combination of terms. Demonstrations of the use
+of contrasts for various designs can be found in the examples section
+of the help page for the \Rfunction{results} function. The
+mathematical formula that is used to generate the contrasts can be found in
+Section~\ref{sec:ctrstTheory}.
+
+\subsection{Interactions} \label{sec:interactions}
+
+Interaction terms can be added to the design formula, in order to
+test, for example, if the log2 fold change attributable to a given
+condition is \textit{different} based on another factor, for example if the
+condition effect differs across genotype.
+
+Many users begin to add interaction terms to the design formula, when
+in fact a much simpler approach would give all the results tables that
+are desired. We will explain this approach first, because it is much
+simpler to perform.
+If the comparisons of interest are, for example, the effect
+of a condition for different sets of samples, a simpler approach than
+adding interaction terms explicitly to the design formula is to
+perform the following steps:
+
+\begin{enumerate}
+\item combine the factors of interest into a single factor with all
+ combinations of the original factors
+\item change the design to include just this factor, e.g. \Robject{\lowtilde{} group}
+\end{enumerate}
+
+Using this design is similar to adding an interaction term,
+in that it models multiple condition effects which
+can be easily extracted with \Rfunction{results}.
+Suppose we have two factors \Robject{genotype} (with values I, II, and III)
+and \Robject{condition} (with values A and B), and we want to extract
+the condition effect specifically for each genotype. We could use the
+following approach to obtain, e.g. the condition effect for genotype I:
+
+<<combineFactors, eval=FALSE>>=
+dds$group <- factor(paste0(dds$genotype, dds$condition))
+design(dds) <- ~ group
+dds <- DESeq(dds)
+resultsNames(dds)
+results(dds, contrast=c("group", "IB", "IA"))
+@
+
+<<interFig, dev="pdf", fig.width=4, fig.height=3, echo=FALSE, results="hide">>=
+npg <- 20
+mu <- 2^c(8,10,9,11,10,12)
+cond <- rep(rep(c("A","B"),each=npg),3)
+geno <- rep(c("I","II","III"),each=2*npg)
+table(cond, geno)
+counts <- rnbinom(6*npg, mu=rep(mu,each=npg), size=1/.01)
+d <- data.frame(log2c=log2(counts+1), cond, geno)
+library(ggplot2)
+plotit <- function(d, title) {
+ ggplot(d, aes(x=cond, y=log2c, group=geno)) +
+ geom_jitter(size=1.5, position = position_jitter(width=.15)) +
+ facet_wrap(~ geno) +
+ stat_summary(fun.y=mean, geom="line", colour="red", size=0.8) +
+ xlab("condition") + ylab("log2(counts+1)") + ggtitle(title)
+}
+plotit(d, "Gene 1") + ylim(7,13)
+lm(log2c ~ cond + geno + geno:cond, data=d)
+@
+
+<<interFig2, dev="pdf", fig.width=4, fig.height=3, echo=FALSE, results="hide">>=
+mu[4] <- 2^12
+mu[6] <- 2^8
+counts <- rnbinom(6*npg, mu=rep(mu,each=npg), size=1/.01)
+d2 <- data.frame(log2c=log2(counts + 1), cond, geno)
+plotit(d2, "Gene 2") + ylim(7,13)
+lm(log2c ~ cond + geno + geno:cond, data=d2)
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.49\textwidth]{figure/interFig-1}
+\includegraphics[width=.49\textwidth]{figure/interFig2-1}
+\caption{
+ \textbf{Genotype-specific condition effects.}
+ Here, the y-axis represents $\log_2(\textrm{counts}+1)$, and each
+ group has 20 samples (black dots). A red line connects the mean of
+ the groups within each genotype.
+ On the left side (Gene 1), note that the condition effect is consistent
+ across genotypes. Although condition A has a different baseline for
+ I,II, and III, the condition effect is a log2 fold change of about 2
+ for each genotype.
+ Using a model with an interaction term \Robject{genotype:condition},
+ the interaction terms for genotype II and genotype III will be nearly 0.
+ On the right side (Gene 2), we can see that the condition effect is
+ not consistent across genotype. Here the main condition effect (the
+ effect for the reference genotype I) is again 2. However, this time
+ the interaction terms will be around 1 for genotype II and
+ -4 for genotype III. This is
+ because the condition effect is higher by 1 for genotype II compared to
+ genotype I, and lower by 4 for genotype III compared to genotype I.
+ The condition effect for genotype II (or III) is obtained by adding the
+ main condition effect and the interaction term for that genotype.
+ Such a plot can be made using the \Rfunction{plotCounts} function
+ (Section~\ref{sec:plotcounts}).
+}
+\label{fig:inter}
+\end{figure}
+
+Now we will continue to explain the use of interactions in order to
+test for \textit{differences} in condition effects. We continue with
+the example of condition effects across three genotypes (I, II, and III).
+For a diagram of how interactions might look across genotypes
+please refer to Figure \ref{fig:inter}.
+
+The key point to remember about designs with interaction terms is
+that, unlike for a design \Robject{\lowtilde{}
+ genotype + condition}, where the condition effect represents the
+\textit{overall} effect controlling for differences due to genotype, by adding
+\Robject{genotype:condition}, the main condition effect only
+represents the effect of condition for the \textit{reference level} of
+genotype (I, or whichever level was defined by the user as the
+reference level). The interaction terms \Robject{genotypeII.conditionB}
+and \Robject{genotypeIII.conditionB} give the \textit{difference}
+between the condition effect for a given genotype and the condition
+effect for the reference genotype.
+
+This genotype-condition interaction example is examined in further
+detail in Example 3 in the help page for \Rfunction{results}, which
+can be found by typing \Rcode{?results}. In particular, we show how to
+test for differences in the condition effect across genotype, and we
+show how to obtain the condition effect for non-reference genotypes.
+Note that in \deseqtwo{} version 1.10, the \Rfunction{DESeq} function will turn
+off log fold change shrinkage (setting \Robject{betaPrior=FALSE}),
+for designs which contain an interaction term. Turning off the log
+fold change shrinkage allows the software to use standard model
+matrices (as would be produced by \Rfunction{model.matrix}), where the
+interaction coefficients are easier to interpret.
+
+\subsection{Time-series experiments}
+
+There are a number of ways to analyze time-series experiments,
+depending on the biological question of interest. In order to test for
+any differences over multiple time points, once can use a design
+including the time factor, and then test using the likelihood ratio
+test as described in Section~\ref{sec:LRT}, where the time factor is
+removed in the reduced formula. For a control and treatment time
+series, one can use a design formula containing the condition factor,
+the time factor, and the interaction of the two. In this case, using
+the likelihood ratio test with a reduced model which does not contain
+the interaction terms will test whether the condition induces a change
+in gene expression at any time point after the reference level time point
+(time 0). An example of the later analysis is provided in an RNA-seq
+workflow on the Bioconductor
+website: \url{http://www.bioconductor.org/help/workflows/rnaseqGene/}.
+
+\subsection{Likelihood ratio test} \label{sec:LRT}
+
+\deseqtwo{} offers two kinds of hypothesis tests: the Wald test, where
+we use the estimated standard error of a log2 fold change to test if it is
+equal to zero, and the likelihood ratio test (LRT). The LRT examines
+two models for the counts, a \emph{full} model with a certain number
+of terms and a \emph{reduced} model, in which some of the terms of the
+\emph{full} model are removed. The test determines if the increased
+likelihood of the data using the extra terms in the \emph{full} model
+is more than expected if those extra terms are truly zero.
+
+The LRT is therefore useful for testing multiple
+terms at once, for example testing 3 or more levels of a factor at once,
+or all interactions between two variables.
+The LRT for count data is conceptually similar to an analysis of variance (ANOVA)
+calculation in linear regression, except that in the case of the Negative
+Binomial GLM, we use an analysis of deviance (ANODEV), where the
+\emph{deviance} captures the difference in likelihood between a full
+and a reduced model.
+
+The likelihood ratio test can be specified using the \Robject{test}
+argument to \Rfunction{DESeq}, which substitutes
+\Rfunction{nbinomWaldTest} with \Rfunction{nbinomLRT}. In this case,
+the user needs to provide a reduced formula, e.g. one in which a
+number of terms from \Robject{design(dds)} are removed.
+The degrees of freedom for the test is obtained from the difference
+between the number of parameters in the two models.
+
+\subsection{Approach to count outliers} \label{sec:outlierApproach}
+
+RNA-seq data sometimes contain isolated instances of very large counts that are apparently
+unrelated to the experimental or study design, and which may be
+considered outliers. There are many reasons why outliers can arise, including rare
+technical or experimental artifacts, read mapping problems in the case of genetically
+differing samples, and genuine, but rare biological events. In many cases, users appear
+primarily interested in genes that show a consistent behavior, and this is the reason why
+by default, genes that are affected by such outliers are set aside by \deseqtwo{},
+or if there are sufficient samples, outlier counts are replaced for model fitting.
+These two behaviors are described below.
+
+The \Rfunction{DESeq} function calculates, for every gene and for every sample,
+a diagnostic test for outliers called \emph{Cook's distance}. Cook's distance
+is a measure of how much a single sample is influencing the fitted
+coefficients for a gene, and a large value of Cook's distance is
+intended to indicate an outlier count.
+The Cook's distances are stored as a matrix available in
+\Robject{assays(dds)[["cooks"]]}.
+
+The \Rfunction{results} function automatically flags genes which contain a
+Cook's distance above a cutoff for samples which have 3 or more replicates.
+The $p$ values and adjusted $p$ values for these genes are set to \Robject{NA}.
+At least 3 replicates are required for flagging, as it is difficult to judge
+which sample might be an outlier with only 2 replicates.
+This filtering can be turned off with \Rcode{results(dds, cooksCutoff=FALSE)}.
+
+With many degrees of freedom -- i.\,e., many more samples than number of parameters to
+be estimated -- it is undesirable to remove entire genes from the analysis
+just because their data include a single count outlier. When there
+are 7 or more replicates for a given sample, the \Rfunction{DESeq}
+function will automatically replace counts with large Cook's distance
+with the trimmed mean over all samples, scaled up by the size factor or
+normalization factor for that sample. This approach is conservative,
+it will not lead to false positives, as it replaces
+the outlier value with the value predicted by the null hypothesis.
+This outlier replacement only occurs when there are 7 or more
+replicates, and can be turned off with
+\Rcode{DESeq(dds, minReplicatesForReplace=Inf)}.
+
+The default Cook's distance cutoff for the two behaviors described above
+depends on the sample size and number of parameters
+to be estimated. The default is to use the $99\%$ quantile of the
+$F(p,m-p)$ distribution (with $p$ the number of parameters including the
+intercept and $m$ number of samples).
+The default for gene flagging can be modified using the \Robject{cooksCutoff}
+argument to the \Rfunction{results} function.
+For outlier replacement, \Rfunction{DESeq} preserves the original counts in
+\Robject{counts(dds)} saving the replacement counts as a matrix named
+\Robject{replaceCounts} in \Robject{assays(dds)}.
+Note that with continuous variables in the design, outlier detection
+and replacement is not automatically performed, as our
+current methods involve a robust estimation of within-group variance
+which does not extend easily to continuous covariates. However, users
+can examine the Cook's distances in \Rcode{assays(dds)[["cooks"]]}, in
+order to perform manual visualization and filtering if necessary.
+
+\textbf{Note on many outliers:} if there are very many outliers
+(e.g. many hundreds or thousands) reported by
+\Rcode{summary(res)}, one might consider further exploration to see if
+a single sample or a few samples should be removed due to low quality.
+The automatic outlier filtering/replacement is most useful in situations which the number
+of outliers is limited. When there are thousands of reported outliers,
+it might make more sense to turn off the outlier filtering/replacement
+(\Rfunction{DESeq} with \Robject{minReplicatesForReplace=Inf} and
+\Rfunction{results} with \Robject{cooksCutoff=FALSE})
+and perform manual inspection: First it would be
+advantageous to make a PCA plot using the code example in Section
+\ref{sec:pca} to spot individual sample outliers; Second, one can make
+a boxplot of the Cook's distances to see if one sample is consistently
+higher than others:
+
+<<boxplotCooks>>=
+par(mar=c(8,5,2,2))
+boxplot(log10(assays(dds)[["cooks"]]), range=0, las=2)
+@
+
+\incfig{figure/boxplotCooks-1}{.5\textwidth}{Boxplot of Cook's distances.}{
+ Here we can look to see if one sample has much higher Cook's distances
+ than the other samples. In this case, the samples all have
+ comparable range of Cook's distances.
+}
+
+\subsection{Dispersion plot and fitting alternatives}
+
+Plotting the dispersion estimates is a useful diagnostic. The dispersion
+plot in Figure \ref{figure/dispFit-1} is typical, with the final estimates shrunk
+from the gene-wise estimates towards the fitted estimates. Some gene-wise
+estimates are flagged as outliers and not shrunk towards the fitted value,
+(this outlier detection is described in the man page for \Rfunction{estimateDispersionsMAP}).
+The amount of shrinkage can be more or less than seen here, depending
+on the sample size, the number of coefficients, the row mean
+and the variability of the gene-wise estimates.
+
+<<dispFit>>=
+plotDispEsts(dds)
+@
+
+\incfig{figure/dispFit-1}{.5\textwidth}{Dispersion plot.}{
+ The dispersion estimate plot shows the gene-wise estimates (black),
+ the fitted values (red), and the final maximum \textit{a posteriori}
+ estimates used in testing (blue).
+}
+
+\subsubsection{Local or mean dispersion fit}
+
+A local smoothed dispersion fit is automatically substitited in the case that
+the parametric curve doesn't fit the observed dispersion mean relationship.
+This can be prespecified by providing the argument
+\Robject{fitType="local"} to either \Rfunction{DESeq} or \Rfunction{estimateDispersions}.
+Additionally, using the mean of gene-wise disperion estimates as the
+fitted value can be specified by providing the argument \Robject{fitType="mean"}.
+
+\subsubsection{Supply a custom dispersion fit}
+
+Any fitted values can be provided during dispersion estimation, using
+the lower-level functions described in the manual page for
+\Rfunction{estimateDispersionsGeneEst}. In the code chunk below, we
+store the gene-wise estimates which were already calculated and saved
+in the metadata column \Robject{dispGeneEst}. Then we calculate the
+median value of the dispersion estimates above a threshold, and save
+these values as the fitted dispersions, using the replacement function
+for \Rfunction{dispersionFunction}. In the last line, the function
+\Rfunction{estimateDispersionsMAP}, uses the
+fitted dispersions to generate maximum \textit{a posteriori} (MAP)
+estimates of dispersion.
+
+<<dispFitCustom>>=
+ddsCustom <- dds
+useForMedian <- mcols(ddsCustom)$dispGeneEst > 1e-7
+medianDisp <- median(mcols(ddsCustom)$dispGeneEst[useForMedian],na.rm=TRUE)
+dispersionFunction(ddsCustom) <- function(mu) medianDisp
+ddsCustom <- estimateDispersionsMAP(ddsCustom)
+@
+
+
+\subsection{Independent filtering of results}\label{sec:autoFilt}
+
+The \Rfunction{results} function of the \deseqtwo{} package
+performs independent filtering by default using
+the mean of normalized counts as a filter statistic.
+A threshold on the filter statistic is found which optimizes the number
+of adjusted $p$ values lower than a significance level \Robject{alpha}
+(we use the standard variable name for significance level,
+though it is unrelated to the dispersion parameter $\alpha$).
+The theory behind independent filtering is discussed in greater detail
+in Section~\ref{sec:indepfilt}. The adjusted $p$ values for the genes
+which do not pass the filter threshold are set to \Robject{NA}.
+
+The independent filtering is performed using the \Rfunction{filtered\_p} function
+of the \Biocpkg{genefilter} package, and all of the arguments of \Rfunction{filtered\_p}
+can be passed to the \Rfunction{results} function.
+The filter threshold value and the number of rejections at each quantile
+of the filter statistic are available as metadata of the object
+returned by \Rfunction{results}. For example, we can visualize
+the optimization by plotting the \Robject{filterNumRej} attribute of
+the results object, as seen in Figure \ref{figure/filtByMean-1}.
+
+<<filtByMean, dev="pdf">>=
+metadata(res)$alpha
+metadata(res)$filterThreshold
+plot(metadata(res)$filterNumRej,
+ type="b", ylab="number of rejections",
+ xlab="quantiles of filter")
+lines(metadata(res)$lo.fit, col="red")
+abline(v=metadata(res)$filterTheta)
+@
+
+\incfig{figure/filtByMean-1}{.5\textwidth}{Independent filtering.}{
+ The \Rfunction{results} function maximizes the
+ number of rejections (adjusted $p$ value less than a
+ significance level), over the quantiles
+ of a filter statistic (the mean of normalized counts).
+ The threshold chosen (vertical line) is
+ the lowest quantile of the filter for which the
+ number of rejections is within 1 residual standard deviation to the
+ peak of a curve fit
+ to the number of rejections over the filter quantiles.
+}
+
+Independent filtering can be turned off by setting
+\Robject{independentFiltering} to \Robject{FALSE}.
+
+<<noFilt>>=
+resNoFilt <- results(dds, independentFiltering=FALSE)
+addmargins(table(filtering=(res$padj < .1), noFiltering=(resNoFilt$padj < .1)))
+@
+
+\subsection{Tests of log2 fold change above or below a threshold}
+
+It is also possible to provide thresholds for constructing
+Wald tests of significance. Two arguments to the \Rfunction{results}
+function allow for threshold-based Wald tests: \Robject{lfcThreshold},
+which takes a numeric of a non-negative threshold value,
+and \Robject{altHypothesis}, which specifies the kind of test.
+Note that the \textit{alternative hypothesis} is specified by the user,
+i.e. those genes which the user is interested in finding, and the test
+provides $p$ values for the null hypothesis, the complement of the set
+defined by the alternative. The \Robject{altHypothesis} argument can take one
+of the following four values, where $\beta$ is the log2 fold change
+specified by the \Robject{name} argument:
+
+\begin{itemize}
+ \item \Robject{greaterAbs} - $|\beta| > \textrm{lfcThreshold}$ - tests are two-tailed
+ \item \Robject{lessAbs} - $|\beta| < \textrm{lfcThreshold}$ - $p$ values are the maximum of the upper and lower tests
+ \item \Robject{greater} - $\beta > \textrm{lfcThreshold} $
+ \item \Robject{less} - $\beta < -\textrm{lfcThreshold} $
+\end{itemize}
+
+The test \Robject{altHypothesis="lessAbs"} requires that the user have
+run \Rfunction{DESeq} with the argument \Robject{betaPrior=FALSE}. To
+understand the reason for this requirement, consider that during
+hypothesis testing, the null hypothesis is favored unless the data
+provide strong evidence to reject the null. For this test, including
+a zero-centered prior on log fold change would favor the alternative
+hypothesis, shrinking log fold changes toward zero. Removing the
+prior on log fold changes for tests of small log fold change allows
+for detection of only those genes where the data alone provides
+evidence against the null.
+
+The four possible values of \Robject{altHypothesis} are demonstrated
+in the following code and visually by MA-plots in Figure~\ref{figure/lfcThresh-1}.
+First we run \Rfunction{DESeq} and specify \Robject{betaPrior=FALSE} in order
+to demonstrate \Robject{altHypothesis="lessAbs"}.
+
+<<ddsNoPrior>>=
+ddsNoPrior <- DESeq(dds, betaPrior=FALSE)
+@
+
+In order to produce results tables for the following tests, the same arguments
+(except \Robject{ylim}) would be provided to the \Rfunction{results} function.
+
+<<lfcThresh>>=
+par(mfrow=c(2,2),mar=c(2,2,1,1))
+yl <- c(-2.5,2.5)
+
+resGA <- results(dds, lfcThreshold=.5, altHypothesis="greaterAbs")
+resLA <- results(ddsNoPrior, lfcThreshold=.5, altHypothesis="lessAbs")
+resG <- results(dds, lfcThreshold=.5, altHypothesis="greater")
+resL <- results(dds, lfcThreshold=.5, altHypothesis="less")
+
+plotMA(resGA, ylim=yl)
+abline(h=c(-.5,.5),col="dodgerblue",lwd=2)
+plotMA(resLA, ylim=yl)
+abline(h=c(-.5,.5),col="dodgerblue",lwd=2)
+plotMA(resG, ylim=yl)
+abline(h=.5,col="dodgerblue",lwd=2)
+plotMA(resL, ylim=yl)
+abline(h=-.5,col="dodgerblue",lwd=2)
+@
+
+\incfig{figure/lfcThresh-1}{.5\textwidth}{MA-plots of tests of log2 fold
+ change with respect to a threshold value.}{
+ Going left to right across rows, the tests are for \Robject{altHypothesis = "greaterAbs"},
+ \Robject{"lessAbs"}, \Robject{"greater"}, and \Robject{"less"}.
+}
+
+\subsection{Access to all calculated values}\label{sec:access}
+
+All row-wise calculated values (intermediate dispersion calculations,
+coefficients, standard errors, etc.) are stored in the \Rclass{DESeqDataSet}
+object, e.g. \Robject{dds} in this vignette. These values are accessible
+by calling \Rfunction{mcols} on \Robject{dds}.
+Descriptions of the columns are accessible by two calls to
+\Rfunction{mcols}.
+
+<<mcols>>=
+mcols(dds,use.names=TRUE)[1:4,1:4]
+# here using substr() only for display purposes
+substr(names(mcols(dds)),1,10)
+mcols(mcols(dds), use.names=TRUE)[1:4,]
+@
+
+The mean values $\mu_{ij} = s_j q_{ij}$ and the Cook's distances for each gene and
+sample are stored as matrices in the assays slot:
+
+<<muAndCooks>>=
+head(assays(dds)[["mu"]])
+head(assays(dds)[["cooks"]])
+@
+
+The dispersions $\alpha_i$ can be accessed with the
+\Rfunction{dispersions} function.
+
+<<dispersions>>=
+head(dispersions(dds))
+# which is the same as
+head(mcols(dds)$dispersion)
+@
+
+The size factors $s_j$ are accessible via \Rfunction{sizeFactors}:
+
+<<sizefactors>>=
+sizeFactors(dds)
+@
+
+For advanced users, we also include a convenience function \Rfunction{coef} for
+extracting the matrix of coefficients $[\beta_{ir}]$ for all genes $i$ and
+parameters $r$, as in the formula in Section~\ref{sec:glm}.
+This function can also return a matrix of standard errors, see \Robject{?coef}.
+The columns of this matrix correspond to the effects returned by \Rfunction{resultsNames}.
+Note that the \Rfunction{results} function is best for building
+results tables with $p$ values and adjusted $p$ values.
+
+<<coef>>=
+head(coef(dds))
+@
+
+The beta prior variance $\sigma_r^2$ is stored as an attribute of the
+\Rclass{DESeqDataSet}:
+
+<<betaPriorVar>>=
+attr(dds, "betaPriorVar")
+@
+
+The dispersion prior variance $\sigma_d^2$ is stored as an
+attribute of the dispersion function:
+
+<<dispPriorVar>>=
+dispersionFunction(dds)
+attr(dispersionFunction(dds), "dispPriorVar")
+@
+
+\subsection{Sample-/gene-dependent normalization factors} \label{sec:normfactors}
+
+In some experiments, there might be gene-dependent dependencies
+which vary across samples. For instance, GC-content bias or length
+bias might vary across samples coming from different labs or
+processed at different times. We use the terms ``normalization factors''
+for a gene $\times$ sample matrix, and ``size factors'' for a
+single number per sample. Incorporating normalization factors,
+the mean parameter $\mu_{ij}$ from Section~\ref{sec:glm} becomes:
+
+$$ \mu_{ij} = NF_{ij} q_{ij} $$
+
+with normalization factor matrix $NF$ having the same dimensions
+as the counts matrix $K$. This matrix can be incorporated as shown
+below. We recommend providing a matrix with row-wise geometric means of $1$,
+so that the mean of normalized counts for a gene is close to the mean
+of the unnormalized counts.
+This can be accomplished by dividing out the current row geometric means.
+
+<<normFactors, eval=FALSE>>=
+normFactors <- normFactors / exp(rowMeans(log(normFactors)))
+normalizationFactors(dds) <- normFactors
+@
+
+These steps then replace \Rfunction{estimateSizeFactors} in the steps
+described in Section~\ref{sec:steps}. Normalization factors, if present,
+will always be used in the place of size factors.
+
+The methods provided by the \Biocpkg{cqn} or \Biocpkg{EDASeq} packages
+can help correct for GC or length biases. They both describe in their
+vignettes how to create matrices which can be used by \deseqtwo{}.
+From the formula above, we see that normalization factors should be on
+the scale of the counts, like size factors, and unlike offsets which
+are typically on the scale of the predictors (i.e. the logarithmic scale for
+the negative binomial GLM). At the time of writing, the transformation
+from the matrices provided by these packages should be:
+
+<<offsetTransform, eval=FALSE>>=
+cqnOffset <- cqnObject$glm.offset
+cqnNormFactors <- exp(cqnOffset)
+EDASeqNormFactors <- exp(-1 * EDASeqOffset)
+@
+
+\subsection{``Model matrix not full rank''}
+
+While most experimental designs run easily using design formula, some
+design formulas can cause problems and result in the \Rfunction{DESeq}
+function returning an error with the text: ``the model matrix is not
+full rank, so the model cannot be fit as specified.'' There are two
+main reasons for this problem: either one or more columns in the model
+matrix are linear combinations of other columns, or there are levels
+of factors or combinations of levels of multiple factors which are
+missing samples. We address these two problems below and discuss
+possible solutions:
+
+\subsubsection{Linear combinations}
+
+The simplest case is the linear combination, or linear dependency
+problem, when two variables contain exactly the same information, such
+as in the following sample table. The software cannot fit an effect
+for \Robject{batch} and \Robject{condition}, because they produce
+identical columns in the model matrix. This is also referred to as
+``perfect confounding''. A unique solution of coefficients (the $\beta_i$ in
+the formula in Section~\ref{sec:glm}) is not possible.
+
+<<lineardep, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,2,2)), condition=factor(c("A","A","B","B")))
+@
+
+Another situation which will cause problems is when the variables are
+not identical, but one variable can be formed by the combination of
+other factor levels. In the following example, the effect of batch 2
+vs 1 cannot be fit because it is identical to a column in the model
+matrix which represents the condition C vs A effect.
+
+<<lineardep2, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,1,1,2,2)), condition=factor(c("A","A","B","B","C","C")))
+@
+
+In both of these cases above, the batch effect cannot be fit and must
+be removed from the model formula. There is just no way to tell apart
+the condition effects and the batch effects. The options are either to assume
+there is no batch effect (which we know is highly unlikely given the
+literature on batch effects in sequencing datasets) or to repeat the
+experiment and properly balance the conditions across batches.
+A balanced design would look like:
+
+<<lineardep3, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,1,2,2,2)), condition=factor(c("A","B","C","A","B","C")))
+@
+
+Finally, there is a case where we can in fact perform inference.
+Consider an experiment with grouped individuals,
+where we seek to test the group-specific effect of a treatment, while
+controlling for individual effects. A simple example of such a design is:
+
+<<groupeffect>>=
+(coldata <- data.frame(grp=factor(rep(c("X","Y"),each=4)),
+ ind=factor(rep(1:4,each=2)),
+ cnd=factor(rep(c("A","B"),4))))
+@
+
+
+This design can be analyzed by \deseqtwo{} but requires a bit of
+refactoring in order to fit the model terms. Here we will use a trick
+described in the \Biocpkg{edgeR} user guide, from the section
+``Comparisons Both Between and Within Subjects''. If we try to
+analyze with a formula such as, \Rcode{$\sim$ ind + grp*cnd}, we will
+obtain an error, because the effect for group is a linear combination
+of the individuals.
+
+However, the following steps allow for an analysis of group-specific
+condition effects, while controlling for differences in individual.
+For object construction, use a dummy design, such as \Rcode{$\sim$
+ 1}. Then add a column \Robject{ind.n} which distinguishes the
+individuals ``nested'' within a group. Here, we add this column to
+coldata, but in practice you would add this column to \Rcode{dds}.
+
+<<groupeffect2>>=
+coldata$ind.n <- factor(rep(rep(1:2,each=2),2))
+coldata
+@
+
+Now we can reassign our \Rclass{DESeqDataSet} a design of
+\Rcode{$\sim$ grp + grp:ind.n + grp:cnd}, before we call
+\Rfunction{DESeq}. This new design will result in the following model
+matrix:
+
+<<groupeffect3>>=
+model.matrix(~ grp + grp:ind.n + grp:cnd, coldata)
+@
+
+where the terms \Robject{grpX.cndB} and \Robject{grpY.cndB} give the
+group-specific condition effects. These can be extracted using
+\Rfunction{results} with the \Robject{name} argument.
+Furthermore, \Robject{grpX.cndB} and
+\Robject{grpY.cndB} can be contrasted using the \Robject{contrast}
+argument, in order to test if the condition effect is different across group:
+
+<<groupeffect4, eval=FALSE>>=
+results(dds, contrast=list("grpY.cndB","grpX.cndB"))
+@
+
+\subsubsection{Levels without samples}
+
+The base R function for creating model matrices will produce a column
+of zeros if a level is missing from a factor or a combination of
+levels is missing from an interaction of factors. The solution to the
+first case is to call \Rfunction{droplevels} on the column, which will
+remove levels without samples. This was shown in the beginning of this
+vignette.
+
+The second case is also solvable, by manually editing the model
+matrix, and then providing this to \Rfunction{DESeq}. Here we
+construct an example dataset to illustrate:
+
+<<missingcombo>>=
+group <- factor(rep(1:3,each=6))
+condition <- factor(rep(rep(c("A","B","C"),each=2),3))
+(d <- data.frame(group, condition)[-c(17,18),])
+@
+
+Note that if we try to estimate all interaction terms, we introduce a
+column with all zeros, as there are no condition C samples for group
+3. (Here, \Rfunction{unname} is used to display the matrix concisely.)
+
+<<missingcombo2>>=
+m1 <- model.matrix(~ condition*group, d)
+colnames(m1)
+unname(m1)
+@
+
+We can remove this column like so:
+
+<<missingcombo3>>=
+m1 <- m1[,-9]
+unname(m1)
+@
+
+Now this matrix \Robject{m1} can be provided to the \Robject{full}
+argument of \Rfunction{DESeq}. For a likelihood ratio test of
+interactions, a model matrix using a reduced design such as
+\Rcode{$\sim$ condition + group} can be given to the \Robject{reduced}
+argument. Wald tests can also be generated instead of the likelihood
+ratio test, but for user-supplied model matrices, the argument
+\Robject{betaPrior} must be set to \Robject{FALSE}.
+
+\newpage
+
+%--------------------------------------------------
+\section{Theory behind DESeq2}
+%--------------------------------------------------
+
+\subsection{The DESeq2 model} \label{sec:glm}
+
+The \deseqtwo{} model and all the steps taken in the software
+are described in detail in our publication \cite{Love2014},
+and we include the formula and descriptions in this section as well.
+The differential expression analysis in \deseqtwo{} uses a generalized
+linear model of the form:
+
+$$ K_{ij} \sim \textrm{NB}(\mu_{ij}, \alpha_i) $$
+$$ \mu_{ij} = s_j q_{ij} $$
+$$ \log_2(q_{ij}) = x_{j.} \beta_i $$
+
+where counts $K_{ij}$ for gene $i$, sample $j$ are modeled using
+a negative binomial distribution with fitted mean $\mu_{ij}$
+and a gene-specific dispersion parameter $\alpha_i$.
+The fitted mean is composed of a sample-specific size factor
+$s_j$\footnote{The model can be generalized to use sample-
+\textbf{and} gene-dependent normalization factors, see
+Appendix~\ref{sec:normfactors}.} and a parameter $q_{ij}$
+proportional to the expected true concentration of fragments for sample $j$.
+The coefficients $\beta_i$ give the log2 fold changes for gene $i$ for each
+column of the model matrix $X$.
+
+By default these log2 fold changes are the maximum \emph{a posteriori} estimates after incorporating a
+zero-centered Normal prior -- in the software referrred to as a $\beta$-prior -- hence \deseqtwo{}
+provides ``moderated'' log2 fold change estimates. Dispersions are estimated using expected mean
+values from the maximum likelihood estimate of log2 fold changes, and optimizing the Cox-Reid
+adjusted profile likelihood, as first implemented for RNA-seq data in \Biocpkg{edgeR}
+\cite{CR,edgeR_GLM}. The steps performed by the \Rfunction{DESeq} function are documented in its
+manual page; briefly, they are:
+
+\begin{enumerate}
+\item estimation of size factors $s_j$ by \Rfunction{estimateSizeFactors}
+\item estimation of dispersion $\alpha_i$ by \Rfunction{estimateDispersions}
+\item negative binomial GLM fitting for $\beta_i$ and Wald statistics by
+\Rfunction{nbinomWaldTest}
+\end{enumerate}
+
+For access to all the values calculated during these steps,
+see Section~\ref{sec:access}
+
+\subsection{Changes compared to the \Biocpkg{DESeq} package}
+
+The main changes in the package \deseqtwo{}, compared to the (older)
+version \Biocpkg{DESeq}, are as follows:
+
+\begin{itemize}
+\item \Rclass{RangedSummarizedExperiment} is used as the superclass for storage of input data,
+ intermediate calculations and results.
+\item Maximum \textit{a posteriori} estimation of GLM coefficients
+ incorporating a zero-centered
+ Normal prior with variance estimated from data (equivalent to Tikhonov/ridge
+ regularization). This adjustment has little effect on genes with high counts, yet it
+ helps to moderate the otherwise large variance in log2 fold change estimates
+ for genes with low counts or highly variable counts.
+\item Maximum \textit{a posteriori} estimation of dispersion replaces the
+ \Robject{sharingMode} options \Robject{fit-only} or \Robject{maximum} of the previous version
+ of the package. This is similar to the dispersion estimation methods of DSS \cite{Wu2012New}.
+\item All estimation and inference is based on the generalized linear model, which
+ includes the two condition case (previously the \textit{exact test} was used).
+\item The Wald test for significance of GLM coefficients is provided as the default
+ inference method, with the likelihood ratio test of the previous version still available.
+\item It is possible to provide a matrix of sample-/gene-dependent
+ normalization factors (Section \ref{sec:normfactors}).
+\item Automatic independent filtering on the mean of normalized counts
+ (Section \ref{sec:indepfilt}).
+\item Automatic outlier detection and handling (Section \ref{sec:cooks}).
+\end{itemize}
+
+\subsection{Methods changes since the 2014 DESeq2 paper}
+
+\begin{itemize}
+ \item For the calculation of the beta prior variance, instead of
+ matching the empirical quantile to the quantile of a Normal
+ distribution, \deseqtwo() now uses the weighted quantile function
+ of the \CRANpkg{Hmisc} package. The weighting is described in the
+ man page for \Rfunction{nbinomWaldTest}. The weights are the
+ inverse of the expected variance of log counts (as used in the
+ diagonals of the matrix $W$ in the GLM). The effect of the change
+ is that the estimated prior variance is robust against noisy
+ estimates of log fold change from genes with very small
+ counts. This change was introduced in version 1.6 (October 2014).
+ \item For designs with interaction terms, the solution described in
+ the paper is no longer used (log fold change shrinkage only
+ applied to interaction terms). Instead, \deseqtwo{} now turns off
+ log fold change shrinkage for all terms if an interaction term is
+ present (\Robject{betaPrior=FALSE}). While the inference on
+ interaction terms was correct with \Robject{betaPrior=TRUE}, the
+ interpretation of the individual terms and the extraction of
+ contrasts was too confusing. This change was introduced in version 1.10
+ (October 2015).
+ \item A small change to the independent filtering routine: instead
+ of taking the quantile of the filter (the mean of normalized counts) which
+ directly \textit{maximizes} the number of rejections, the threshold chosen is
+ the lowest quantile of the filter for which the
+ number of rejections is close to the peak of a curve fit
+ to the number of rejections over the filter quantiles.
+ ``Close to'' is defined as within 1 residual standard deviation.
+ This change was introduced in version 1.10 (October 2015).
+\end{itemize}
+
+For a list of all changes since version 1.0.0, see the NEWS file
+included in the package.
+
+\subsection{Count outlier detection} \label{sec:cooks}
+
+\deseqtwo{} relies on the negative binomial distribution to make
+estimates and perform statistical inference on differences. While the
+negative binomial is versatile in having a mean and dispersion
+parameter, extreme counts in individual samples might not fit well to
+the negative binomial. For this reason, we perform automatic detection
+of count outliers. We use Cook's distance, which is a measure of how
+much the fitted coefficients would change if an individual sample were
+removed \cite{Cook1977Detection}. For more on the implementation of
+Cook's distance see Section~\ref{sec:outlierApproach} and the manual page
+for the \Rfunction{results} function. Below we plot the maximum value of
+Cook's distance for each row over the rank of the test statistic
+to justify its use as a filtering criterion.
+
+<<cooksPlot>>=
+W <- res$stat
+maxCooks <- apply(assays(dds)[["cooks"]],1,max)
+idx <- !is.na(W)
+plot(rank(W[idx]), maxCooks[idx], xlab="rank of Wald statistic",
+ ylab="maximum Cook's distance per gene",
+ ylim=c(0,5), cex=.4, col=rgb(0,0,0,.3))
+m <- ncol(dds)
+p <- 3
+abline(h=qf(.99, p, m - p))
+@
+
+\incfig{figure/cooksPlot-1}{.5\textwidth}{Cook's distance.}{
+ Plot of the maximum Cook's distance per gene over the rank of
+ the Wald statistics for the condition. The two regions with small Cook's
+ distances are genes with a single count in one sample. The horizontal
+ line is the default cutoff used for 7 samples and 3 estimated parameters.
+}
+
+\subsection{Contrasts} \label{sec:ctrstTheory}
+
+Contrasts can be calculated for a \Rclass{DESeqDataSet} object for which
+the GLM coefficients have already been fit using the Wald test steps
+(\Rfunction{DESeq} with \texttt{test="Wald"} or using \Rfunction{nbinomWaldTest}).
+The vector of coefficients $\beta$ is left multiplied by the contrast vector $c$
+to form the numerator of the test statistic. The denominator is formed by multiplying
+the covariance matrix $\Sigma$ for the coefficients on either side by the
+contrast vector $c$. The square root of this product is an estimate
+of the standard error for the contrast. The contrast statistic is then compared
+to a normal distribution as are the Wald statistics for the \deseqtwo{}
+package.
+
+$$ W = \frac{c^t \beta}{\sqrt{c^t \Sigma c}} $$
+
+\subsection{Expanded model matrices} \label{sec:expanded}
+
+\deseqtwo{} uses ``expanded model matrices'' with the log2 fold change prior,
+in order to produce shrunken log2 fold change estimates and test
+results which are independent of the choice of reference level.
+Another way of saying this is that the shrinkage is \textit{symmetric}
+with respect to all the levels of the factors in the design.
+The expanded model matrices differ from the standard model matrices, in that
+they have an indicator column (and therefore a coefficient) for
+each level of factors in the design formula in addition to an intercept.
+Note that in version 1.10 and onward, standard model matrices are used for
+designs with interaction terms, as the shrinkage of log2 fold changes
+is not recommended for these designs.
+
+The expanded model matrices are not full rank, but a coefficient
+vector $\beta_i$ can still be found due to the zero-centered prior on
+non-intercept coefficients. The prior variance for the log2 fold
+changes is calculated by first generating maximum likelihood estimates
+for a standard model matrix. The prior variance for each level of a
+factor is then set as the average of the mean squared maximum
+likelihood estimates for each level and every possible contrast, such
+that that this prior value will be reference-level-independent. The
+\Robject{contrast} argument of the \Rfunction{results} function is
+used in order to generate comparisons of interest.
+
+%--------------------------------------------------
+\subsection{Independent filtering and multiple testing} \label{sec:indepfilt}
+\subsubsection{Filtering criteria} \label{sec:filtbycount}
+%--------------------------------------------------
+
+The goal of independent filtering is to filter out those tests from the procedure
+that have no, or little chance of showing significant evidence, without even
+looking at their test statistic. Typically, this results in increased detection
+power at the same experiment-wide type I error. Here, we measure experiment-wide
+type I error in terms of the false discovery rate.
+
+A good choice for a filtering criterion is one that
+\begin{enumerate}
+ \item\label{it:indp} is statistically independent from the test statistic under the null hypothesis,
+ \item\label{it:corr} is correlated with the test statistic under the alternative, and
+ \item\label{it:joint} does not notably change the dependence structure --if there is any--
+ between the tests that pass the filter, compared to the dependence structure between the tests before filtering.
+\end{enumerate}
+
+The benefit from filtering relies on property \ref{it:corr}, and we will explore
+it further in Section~\ref{sec:whyitworks}. Its statistical validity relies on
+property \ref{it:indp} -- which is simple to formally prove for many combinations
+of filter criteria with test statistics-- and \ref{it:joint}, which is less
+easy to theoretically imply from first principles, but rarely a problem in practice.
+We refer to \cite{Bourgon:2010:PNAS} for further discussion of this topic.
+
+A simple filtering criterion readily available in the results object is the
+mean of normalized counts irrespective of biological condition (Figure \ref{figure/indFilt-1}),
+and so this is the criterion which is used automatically by the
+\Rfunction{results} function to perform independent filtering.
+Genes with very low counts are not likely to
+see significant differences typically due to high
+dispersion. For example, we can plot the $-\log_{10}$ $p$ values from all genes
+over the normalized mean counts.
+
+<<indFilt>>=
+plot(res$baseMean+1, -log10(res$pvalue),
+ log="x", xlab="mean of normalized counts",
+ ylab=expression(-log[10](pvalue)),
+ ylim=c(0,30),
+ cex=.4, col=rgb(0,0,0,.3))
+@
+
+\incfig{figure/indFilt-1}{.5\textwidth}{Mean counts as a filter statistic.}{
+ The mean of normalized counts provides an independent statistic for
+ filtering the tests. It is independent because the information about the
+ variables in the design formula is not used. By filtering out genes which fall
+ on the left side of the plot, the majority of the low $p$ values are kept.
+}
+
+%--------------------------------------------------
+\subsubsection{Why does it work?}\label{sec:whyitworks}
+%--------------------------------------------------
+
+Consider the $p$ value histogram in Figure \ref{figure/fighistindepfilt-1}.
+It shows how the filtering ameliorates the multiple testing problem
+-- and thus the severity of a multiple testing adjustment -- by
+removing a background set of hypotheses whose $p$ values are distributed
+more or less uniformly in $[0,1]$.
+
+<<histindepfilt, dev="pdf", fig.width=7, fig.height=5>>=
+use <- res$baseMean > metadata(res)$filterThreshold
+h1 <- hist(res$pvalue[!use], breaks=0:50/50, plot=FALSE)
+h2 <- hist(res$pvalue[use], breaks=0:50/50, plot=FALSE)
+colori <- c(`do not pass`="khaki", `pass`="powderblue")
+@
+
+<<fighistindepfilt>>=
+barplot(height = rbind(h1$counts, h2$counts), beside = FALSE,
+ col = colori, space = 0, main = "", ylab="frequency")
+text(x = c(0, length(h1$counts)), y = 0, label = paste(c(0,1)),
+ adj = c(0.5,1.7), xpd=NA)
+legend("topright", fill=rev(colori), legend=rev(names(colori)))
+@
+
+\incfig{figure/fighistindepfilt-1}{.5\textwidth}{Histogram of p values for all tests.}{
+ The area shaded in blue indicates the subset of those that pass the filtering,
+ the area in khaki those that do not pass.
+}
+
+\section{Frequently asked questions} \label{sec:faq}
+
+\subsection{How can I get support for DESeq2?}
+
+We welcome questions about our software, and want to
+ensure that we eliminate issues if and when they appear. We have a few
+requests to optimize the process:
+
+\begin{itemize}
+\item all questions should take place on the Bioconductor support
+ site: \url{https://support.bioconductor.org}, which serves as a
+ repository of questions and answers. This helps to save the
+ developers' time in responding to similar questions. Make sure to
+ tag your post with ``deseq2''. It is often very helpful in addition
+ to describe the aim of your experiment.
+\item before posting, first search the Bioconductor support site
+ mentioned above for past threads which might have answered your
+ question.
+\item if you have a question about the behavior of a function, read
+ the sections of the manual page for this function by typing a
+ question mark and the function name, e.g. \Robject{?results}. We
+ spend a lot of time documenting individual functions and the exact
+ steps that the software is performing.
+\item include all of your R code, especially the creation of the
+ \Rclass{DESeqDataSet} and the design formula. Include complete
+ warning or error messages, and conclude your message with the full
+ output of \Robject{sessionInfo()}.
+\item if possible, include the output of
+ \Robject{as.data.frame(colData(dds))}, so that we can have a sense
+ of the experimental setup. If this contains confidential
+ information, you can replace the levels of those factors using
+ \Rfunction{levels()}.
+\end{itemize}
+
+\subsection{Why are some $p$ values set to \texttt{NA}?}
+
+See the details in Section~\ref{sec:moreInfo}.
+
+\subsection{How can I get unfiltered DESeq results?}
+
+Users can obtain unfiltered GLM results, i.e. without outlier removal
+or independent filtering with the following call:
+
+<<vanillaDESeq, eval=FALSE>>=
+dds <- DESeq(dds, minReplicatesForReplace=Inf)
+res <- results(dds, cooksCutoff=FALSE, independentFiltering=FALSE)
+@
+
+In this case, the only $p$ values set to \Robject{NA} are those from
+genes with all counts equal to zero.
+
+\subsection{How do I use the variance stabilized or rlog
+ transformed data for differential testing?}
+
+ The variance stabilizing and rlog transformations are provided for
+ applications other than differential testing, for example clustering
+ of samples or other machine learning applications. For differential
+ testing we recommend the \Rfunction{DESeq} function applied to raw
+ counts as outlined in Section~\ref{sec:de}.
+
+\subsection{Can I use DESeq2 to analyze paired samples?}
+
+Yes, you should use a multi-factor design which includes the sample
+information as a term in the design formula. This will account for
+differences between the samples while estimating the effect due to
+the condition. The condition of interest should go at the end of the
+design formula. See Section~\ref{sec:multifactor}.
+
+\subsection{Can I run DESeq2 to contrast the levels of 100 groups?}
+
+\deseqtwo{} will work with any kind of design specified using the R
+formula. We enourage users to consider exploratory data analysis such
+as principal components analysis as described in Section~\ref{sec:pca},
+rather than performing statistical testing of all combinations of
+dozens of groups.
+
+As a speed concern with fitting very large models,
+note that each additional level of a factor in the
+design formula adds another parameter to the GLM which is fit by
+\deseqtwo. Users might consider first removing genes with very few
+reads, e.g.\ genes with row sum of 1, as this will speed up the
+fitting procedure.
+
+\subsection{Can I use DESeq2 to analyze a dataset without replicates?}
+
+If a \Rclass{DESeqDataSet} is provided with an experimental design without replicates,
+a message is printed, that the samples are treated as replicates
+for estimation of dispersion. More details can be found in the
+manual page for \Rfunction{?DESeq}.
+
+\subsection{How can I include a continuous covariate in the design formula?}
+
+Continuous covariates can be included in the design formula in the
+same manner as factorial covariates. Continuous covariates might make
+sense in certain experiments, where a constant fold change might be
+expected for each unit of the covariate. However, in many cases, more
+meaningful results can be obtained by cutting continuous covariates
+into a factor defined over a small number of bins (e.g. 3-5). In this
+way, the average effect of each group is controlled for, regardless of
+the trend over the continuous covariates. In R, \Rclass{numeric}
+vectors can be converted into \Rclass{factors} using the function
+\Rfunction{cut}.
+
+\subsection{What are the exact steps performed by \Rfunction{DESeq()}?}
+
+See the manual page for \Rfunction{DESeq}, which links to the
+subfunctions which are called in order, where complete details are listed.
+
+\subsection{Is there an official Galaxy tool for DESeq2?}
+
+Yes. The repository for the \deseqtwo{} tool is
+\url{https://github.com/galaxyproject/tools-iuc/tree/master/tools/deseq2}
+and a link to its location in the Tool Shed is
+\url{https://toolshed.g2.bx.psu.edu/view/iuc/deseq2/d983d19fbbab}.
+
+\section{Acknowledgments}
+
+We have benefited in the development of \deseqtwo{} from the help and
+feedback of many individuals, including but not limited to:
+The Bionconductor Core Team,
+Alejandro Reyes, Andrzej Ole\'s, Aleksandra Pekowska, Felix Klein,
+Vince Carey,
+Devon Ryan,
+Steve Lianoglou, Jessica Larson, Christina Chaivorapol, Pan Du, Richard Bourgon,
+Willem Talloen,
+Elin Videvall, Hanneke van Deutekom,
+Todd Burwell,
+Jesse Rowley,
+Igor Dolgalev,
+Stephen Turner,
+Ryan C Thompson,
+Tyr Wiesner-Hanks,
+Konrad Rudolph,
+David Robinson,
+Mingxiang Teng,
+Mathias Lesche,
+Sonali Arora,
+Jordan Ramilowski,
+Ian Dworkin,
+Bj\"orn Gr\"uning,
+Ryan McMinds.
+\section{Session Info}
+
+<<sessInfo, results="asis", echo=FALSE>>=
+toLatex(sessionInfo())
+@
+
+<<resetOptions, results="hide", echo=FALSE>>=
+options(prompt="> ", continue="+ ")
+@
+
+\bibliography{library}
+
+\end{document}
diff --git a/inst/doc/DESeq2.pdf b/inst/doc/DESeq2.pdf
new file mode 100644
index 0000000..f33a0aa
Binary files /dev/null and b/inst/doc/DESeq2.pdf differ
diff --git a/inst/script/deseq2.R b/inst/script/deseq2.R
new file mode 100644
index 0000000..d92ead4
--- /dev/null
+++ b/inst/script/deseq2.R
@@ -0,0 +1,322 @@
+# A command-line interface to DESeq2 for use with Galaxy
+# written by Bjoern Gruening and modified by Michael Love 2015.01.11
+#
+# one of these arguments is required:
+#
+# 'factors' a JSON list object from Galaxy
+#
+# 'sample_table' is a sample table as described in ?DESeqDataSetFromHTSeq
+# with columns: sample name, filename, then factors (variables)
+#
+# the output file has columns:
+#
+# baseMean (mean normalized count)
+# log2FoldChange (by default a moderated LFC estimate)
+# lfcSE (the standard error)
+# stat (the Wald statistic)
+# pvalue (p-value from comparison of Wald statistic to a standard Normal)
+# padj (adjusted p-value, Benjamini Hochberg correction on genes which pass the mean count filter)
+#
+# the first variable in 'factors' and first column in 'sample_table' will be the primary factor.
+# the levels of the primary factor are used in the order of appearance in factors or in sample_table.
+#
+# by default, levels in the order A,B,C produces a single comparison of B vs A, to a single file 'outfile'
+#
+# for the 'many_contrasts' flag, levels in the order A,B,C produces comparisons C vs A, B vs A, C vs B,
+# to a number of files using the 'outfile' prefix: 'outfile.condition_C_vs_A' etc.
+# all plots will still be sent to a single PDF, named by the arg 'plots', with extra pages.
+#
+# fit_type is an integer valued argument, with the options from ?estimateDisperions
+# 1 "parametric"
+# 2 "local"
+# 3 "mean"
+
+# setup R error handling to go to stderr
+options( show.error.messages=F, error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } )
+
+# we need that to not crash galaxy with an UTF8 error on German LC settings.
+loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
+
+library("getopt")
+options(stringAsfactors = FALSE, useFancyQuotes = FALSE)
+args <- commandArgs(trailingOnly = TRUE)
+
+# get options, using the spec as defined by the enclosed list.
+# we read the options from the default: commandArgs(TRUE).
+spec <- matrix(c(
+ "quiet", "q", 0, "logical",
+ "help", "h", 0, "logical",
+ "outfile", "o", 1, "character",
+ "factors", "f", 1, "character",
+ "plots" , "p", 1, "character",
+ "sample_table", "s", 1, "character",
+ "fit_type", "t", 1, "integer",
+ "many_contrasts", "m", 0, "logical",
+ "outlier_replace_off" , "a", 0, "logical",
+ "outlier_filter_off" , "b", 0, "logical",
+ "auto_mean_filter_off", "c", 0, "logical",
+ "beta_prior_off", "d", 0, "logical"),
+ byrow=TRUE, ncol=4)
+opt <- getopt(spec)
+
+# if help was asked for print a friendly message
+# and exit with a non-zero error code
+if (!is.null(opt$help)) {
+ cat(getopt(spec, usage=TRUE))
+ q(status=1)
+}
+
+# enforce the following required arguments
+if (is.null(opt$outfile)) {
+ cat("'outfile' is required\n")
+ q(status=1)
+}
+if (is.null(opt$sample_table) & is.null(opt$factors)) {
+ cat("'factors' or 'sample_table' is required\n")
+ q(status=1)
+}
+
+verbose <- if (is.null(opt$quiet)) {
+ TRUE
+} else {
+ FALSE
+}
+
+suppressPackageStartupMessages({
+ library("DESeq2")
+ library("RColorBrewer")
+ library("gplots")
+})
+
+# build or read sample table
+
+trim <- function (x) gsub("^\\s+|\\s+$", "", x)
+
+# switch on if 'factors' was provided:
+if (!is.null(opt$factors)) {
+ library("rjson")
+ parser <- newJSONParser()
+ parser$addData(opt$factors)
+ factorList <- parser$getObject()
+ factors <- sapply(factorList, function(x) x[[1]])
+ primaryFactor <- factors[1]
+ filenamesIn <- unname(unlist(factorList[[1]][[2]]))
+ sampleTable <- data.frame(sample=basename(filenamesIn), filename=filenamesIn, row.names=filenamesIn)
+ for (factor in factorList) {
+ factorName <- trim(factor[[1]])
+ sampleTable[[factorName]] <- character(nrow(sampleTable))
+ lvls <- sapply(factor[[2]], function(x) names(x))
+ for (i in seq_along(factor[[2]])) {
+ files <- factor[[2]][[i]][[1]]
+ sampleTable[files,factorName] <- trim(lvls[i])
+ }
+ sampleTable[[factorName]] <- factor(sampleTable[[factorName]], levels=lvls)
+ }
+ rownames(sampleTable) <- sampleTable$sample
+} else {
+ # read the sample_table argument
+ # this table is described in ?DESeqDataSet
+ # one column for the sample name, one for the filename, and
+ # the remaining columns for factors in the analysis
+ sampleTable <- read.delim(opt$sample_table)
+ factors <- colnames(sampleTable)[-c(1:2)]
+ for (factor in factors) {
+ lvls <- unique(as.character(sampleTable[[factor]]))
+ sampleTable[[factor]] <- factor(sampleTable[[factor]], levels=lvls)
+ }
+}
+
+primaryFactor <- factors[1]
+designFormula <- as.formula(paste("~", paste(rev(factors), collapse=" + ")))
+
+if (verbose) {
+ cat("DESeq2 run information\n\n")
+ cat("sample table:\n")
+ print(sampleTable[,-c(1:2),drop=FALSE])
+ cat("\ndesign formula:\n")
+ print(designFormula)
+ cat("\n\n")
+}
+
+# these are plots which are made once for each analysis
+generateGenericPlots <- function(dds, factors) {
+ rld <- rlog(dds)
+ print(plotPCA(rld, intgroup=rev(factors)))
+ # need meaningful labels, because from Galaxy, sample names are random
+ labs <- paste0(seq_len(ncol(dds)), ": ", do.call(paste, as.list(colData(dds)[factors])))
+ dat <- assay(rld)
+ colnames(dat) <- labs
+ distsRL <- dist(t(dat))
+ mat <- as.matrix(distsRL)
+ hc <- hclust(distsRL)
+ hmcol <- colorRampPalette(brewer.pal(9, "GnBu"))(100)
+ heatmap.2(mat, Rowv=as.dendrogram(hc), symm=TRUE, trace="none", col = rev(hmcol),
+ main="Sample-to-sample distances", margin=c(13,13))
+ plotDispEsts(dds, main="Dispersion estimates")
+}
+
+# these are plots which can be made for each comparison, e.g.
+# once for C vs A and once for B vs A
+generateSpecificPlots <- function(res, threshold, title_suffix) {
+ use <- res$baseMean > threshold
+ if (sum(!use) == 0) {
+ h <- hist(res$pvalue, breaks=0:50/50, plot=FALSE)
+ barplot(height = h$counts,
+ col = "powderblue", space = 0, xlab="p-values", ylab="frequency",
+ main=paste("Histogram of p-values for",title_suffix))
+ text(x = c(0, length(h1$counts)), y = 0, label=paste(c(0,1)), adj=c(0.5,1.7), xpd=NA)
+ } else {
+ h1 <- hist(res$pvalue[!use], breaks=0:50/50, plot=FALSE)
+ h2 <- hist(res$pvalue[use], breaks=0:50/50, plot=FALSE)
+ colori <- c("filtered (low count)"="khaki", "not filtered"="powderblue")
+ barplot(height = rbind(h1$counts, h2$counts), beside = FALSE,
+ col = colori, space = 0, xlab="p-values", ylab="frequency",
+ main=paste("Histogram of p-values for",title_suffix))
+ text(x = c(0, length(h1$counts)), y = 0, label=paste(c(0,1)), adj=c(0.5,1.7), xpd=NA)
+ legend("topright", fill=rev(colori), legend=rev(names(colori)), bg="white")
+ }
+ plotMA(res, main= paste("MA-plot for",title_suffix), ylim=range(res$log2FoldChange, na.rm=TRUE))
+}
+
+if (verbose) {
+ cat(paste("primary factor:",primaryFactor,"\n"))
+ if (length(factors) > 1) {
+ cat(paste("other factors in design:",paste(factors[-length(factors)],collapse=","),"\n"))
+ }
+ cat("\n---------------------\n")
+}
+
+# if JSON input from Galaxy, path is absolute
+# otherwise, from sample_table, assume it is relative
+dir <- if (is.null(opt$factors)) {
+ "."
+} else {
+ ""
+}
+
+# construct the object
+dds <- DESeqDataSetFromHTSeqCount(sampleTable = sampleTable,
+ directory = dir,
+ design = designFormula)
+
+if (verbose) cat(paste(ncol(dds), "samples with counts over", nrow(dds), "genes\n"))
+
+# optional outlier behavior
+if (is.null(opt$outlier_replace_off)) {
+ minRep <- 7
+} else {
+ minRep <- Inf
+ if (verbose) cat("outlier replacement off\n")
+}
+if (is.null(opt$outlier_filter_off)) {
+ cooksCutoff <- TRUE
+} else {
+ cooksCutoff <- FALSE
+ if (verbose) cat("outlier filtering off\n")
+}
+
+# optional automatic mean filtering
+if (is.null(opt$auto_mean_filter_off)) {
+ independentFiltering <- TRUE
+} else {
+ independentFiltering <- FALSE
+ if (verbose) cat("automatic filtering on the mean off\n")
+}
+
+# shrinkage of LFCs
+if (is.null(opt$beta_prior_off)) {
+ betaPrior <- TRUE
+} else {
+ betaPrior <- FALSE
+ if (verbose) cat("beta prior off\n")
+}
+
+# dispersion fit type
+if (is.null(opt$fit_type)) {
+ fitType <- "parametric"
+} else {
+ fitType <- c("parametric","local","mean")[opt$fit_type]
+}
+
+if (verbose) cat(paste("using disperion fit type:",fitType,"\n"))
+
+# run the analysis
+dds <- DESeq(dds, fitType=fitType, betaPrior=betaPrior, minReplicatesForReplace=minRep)
+
+# create the generic plots and leave the device open
+if (!is.null(opt$plots)) {
+ if (verbose) cat("creating plots\n")
+ pdf(opt$plots)
+ generateGenericPlots(dds, factors)
+}
+
+n <- nlevels(colData(dds)[[primaryFactor]])
+allLevels <- levels(colData(dds)[[primaryFactor]])
+
+if (is.null(opt$many_contrasts)) {
+ # only contrast the first and second level of the primary factor
+ ref <- allLevels[1]
+ lvl <- allLevels[2]
+ res <- results(dds, contrast=c(primaryFactor, lvl, ref),
+ cooksCutoff=cooksCutoff,
+ independentFiltering=independentFiltering)
+ if (verbose) {
+ cat("summary of results\n")
+ cat(paste0(primaryFactor,": ",lvl," vs ",ref,"\n"))
+ print(summary(res))
+ }
+ resSorted <- res[order(res$padj),]
+ outDF <- as.data.frame(resSorted)
+ outDF$geneID <- rownames(outDF)
+ outDF <- outDF[,c("geneID", "baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj")]
+ filename <- opt$outfile
+ write.table(outDF, file=filename, sep="\t", quote=FALSE, row.names=FALSE, col.names=FALSE)
+ if (independentFiltering) {
+ threshold <- unname(attr(res, "filterThreshold"))
+ } else {
+ threshold <- 0
+ }
+ title_suffix <- paste0(primaryFactor,": ",lvl," vs ",ref)
+ if (!is.null(opt$plots)) {
+ generateSpecificPlots(res, threshold, title_suffix)
+ }
+} else {
+ # rotate through the possible contrasts of the primary factor
+ # write out a sorted table of results with the contrast as a suffix
+ # add contrast specific plots to the device
+ for (i in seq_len(n-1)) {
+ ref <- allLevels[i]
+ contrastLevels <- allLevels[(i+1):n]
+ for (lvl in contrastLevels) {
+ res <- results(dds, contrast=c(primaryFactor, lvl, ref),
+ cooksCutoff=cooksCutoff,
+ independentFiltering=independentFiltering)
+ resSorted <- res[order(res$padj),]
+ outDF <- as.data.frame(resSorted)
+ outDF$geneID <- rownames(outDF)
+ outDF <- outDF[,c("geneID", "baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj")]
+ filename <- paste0(opt$outfile,".",primaryFactor,"_",lvl,"_vs_",ref)
+ write.table(outDF, file=filename, sep="\t", quote=FALSE, row.names=FALSE, col.names=FALSE)
+ if (independentFiltering) {
+ threshold <- unname(attr(res, "filterThreshold"))
+ } else {
+ threshold <- 0
+ }
+ title_suffix <- paste0(primaryFactor,": ",lvl," vs ",ref)
+ if (!is.null(opt$plots)) {
+ generateSpecificPlots(res, threshold, title_suffix)
+ }
+ }
+ }
+}
+
+# close the plot device
+if (!is.null(opt$plots)) {
+ cat("closing plot device\n")
+ dev.off()
+}
+
+cat("Session information:\n\n")
+
+sessionInfo()
+
diff --git a/inst/script/makeSim.R b/inst/script/makeSim.R
new file mode 100644
index 0000000..c9de9d0
--- /dev/null
+++ b/inst/script/makeSim.R
@@ -0,0 +1,11 @@
+makeSim <- function(n, m, x, beta, meanDispPairs, sf=rep(1,m)) {
+ idx <- sample(nrow(meanDispPairs), n, replace=TRUE)
+ mu0 <- meanDispPairs[idx,1]
+ disp <- meanDispPairs[idx,2]
+ betafull <- cbind(log2(mu0), beta)
+ mu <- 2^(betafull %*% t(x))
+ muMat <- matrix(rep(mu, times=m) * rep(sf, each=n), ncol=m)
+ list(mat = matrix(rnbinom(n*m, mu=muMat, size=1/disp), ncol=m),
+ disp = disp,
+ mu0 = mu0)
+}
diff --git a/inst/script/runScripts.R b/inst/script/runScripts.R
new file mode 100644
index 0000000..643157a
--- /dev/null
+++ b/inst/script/runScripts.R
@@ -0,0 +1,171 @@
+runDESeq2 <- function(e, retDDS=FALSE) {
+ counts <- exprs(e)
+ mode(counts) <- "integer"
+ dds <- DESeqDataSetFromMatrix(counts, DataFrame(pData(e)), ~ condition)
+ dds <- DESeq(dds,quiet=TRUE)
+ res <- results(dds)
+ beta <- res$log2FoldChange
+ pvals <- res$pvalue
+ padj <- res$padj
+ pvals[is.na(pvals)] <- 1
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj[is.na(padj)] <- 1
+ return(list(pvals=pvals, padj=padj, beta=beta))
+}
+
+runDESeq2Outliers <- function(e, retDDS=FALSE) {
+ counts <- exprs(e)
+ mode(counts) <- "integer"
+ dds <- DESeqDataSetFromMatrix(counts, DataFrame(pData(e)), ~ condition)
+ ddsDefault <- DESeq(dds, quiet=TRUE)
+ ddsNoRepl <- ddsDefault
+ if (ncol(e) >= 14) {
+ # insert original maximum Cook's distances
+ # so the rows with replacement will be filtered
+ # this avoid re-running with minReplicateForReplace=Inf
+ mcols(ddsNoRepl)$maxCooks <- apply(assays(ddsNoRepl)[["cooks"]], 1, max)
+ }
+ resDefault <- results(ddsDefault)
+ resNoFilt <- results(ddsDefault, cooksCutoff=FALSE)
+ resNoRepl <- results(ddsNoRepl)
+ resList <- list("DESeq2"=resDefault, "DESeq2-noFilt"=resNoFilt, "DESeq2-noRepl"=resNoRepl)
+ resOut <- lapply(resList, function(res) {
+ pvals <- res$pvalue
+ padj <- res$padj
+ pvals[is.na(pvals)] <- 1
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj)
+ })
+ return(resOut)
+}
+
+runEdgeR <- function(e) {
+ design <- model.matrix(~ pData(e)$condition)
+ dgel <- DGEList(exprs(e))
+ dgel <- calcNormFactors(dgel)
+ dgel <- estimateGLMCommonDisp(dgel, design)
+ dgel <- estimateGLMTrendedDisp(dgel, design)
+ dgel <- estimateGLMTagwiseDisp(dgel, design)
+ edger.fit <- glmFit(dgel, design)
+ edger.lrt <- glmLRT(edger.fit)
+ predbeta <- predFC(exprs(e), design, offset=getOffset(dgel), dispersion=dgel$tagwise.dispersion)
+ predbeta10 <- predFC(exprs(e), design, prior.count=10, offset=getOffset(dgel), dispersion=dgel$tagwise.dispersion)
+ pvals <- edger.lrt$table$PValue
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- p.adjust(pvals,method="BH")
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj, beta=log2(exp(1)) * edger.fit$coefficients[,"pData(e)$conditionB"],
+ predbeta=predbeta[,"pData(e)$conditionB"], predbeta10=predbeta10[,"pData(e)$conditionB"])
+}
+
+runEdgeRRobust <- function(e) {
+ design <- model.matrix(~ pData(e)$condition)
+ dgel <- DGEList(exprs(e))
+ dgel <- calcNormFactors(dgel)
+ # settings for robust from robinson_lab/edgeR_robust/robust_simulation.R
+ dgel <- estimateGLMRobustDisp(dgel, design, maxit=6)
+ edger.fit <- glmFit(dgel, design)
+ edger.lrt <- glmLRT(edger.fit)
+ predbeta <- predFC(exprs(e), design, offset=getOffset(dgel), dispersion=dgel$tagwise.dispersion)
+ pvals <- edger.lrt$table$PValue
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- p.adjust(pvals,method="BH")
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj, beta=log2(exp(1)) * edger.fit$coefficients[,"pData(e)$conditionB"],
+ predbeta=predbeta[,"pData(e)$conditionB"])
+}
+
+runDSS <- function(e) {
+ X <- as.matrix(exprs(e))
+ colnames(X) <- NULL
+ designs <- as.character(pData(e)$condition)
+ seqData <- newSeqCountSet(X, designs)
+ seqData <- estNormFactors(seqData)
+ seqData <- estDispersion(seqData)
+ result <- waldTest(seqData, "B", "A")
+ result <- result[match(rownames(seqData),rownames(result)),]
+ pvals <- result$pval
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- p.adjust(pvals,method="BH")
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj, beta=( log2(exp(1)) * result$lfc ))
+}
+
+runDSSFDR <- function(e) {
+ X <- as.matrix(exprs(e))
+ colnames(X) <- NULL
+ designs <- as.character(pData(e)$condition)
+ seqData <- newSeqCountSet(X, designs)
+ seqData <- estNormFactors(seqData)
+ seqData <- estDispersion(seqData)
+ result <- waldTest(seqData, "B", "A")
+ result <- result[match(rownames(seqData),rownames(result)),]
+ pvals <- result$pval
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- result$fdr
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj, beta=( log2(exp(1)) * result$lfc ))
+}
+
+runVoom <- function(e) {
+ design <- model.matrix(~ condition, pData(e))
+ dgel <- DGEList(exprs(e))
+ dgel <- calcNormFactors(dgel)
+ v <- voom(dgel,design,plot=FALSE)
+ fit <- lmFit(v,design)
+ fit <- eBayes(fit)
+ tt <- topTable(fit,coef=ncol(design),n=nrow(dgel),sort.by="none")
+ pvals <- tt$P.Value
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- p.adjust(pvals,method="BH")
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals, padj=padj, beta=tt$logFC)
+}
+
+runSAMseq <- function(e) {
+ set.seed(1)
+ x <- exprs(e)
+ y <- pData(e)$condition
+ capture.output({samfit <- SAMseq(x, y, resp.type = "Two class unpaired")})
+ beta <- log2(samfit$samr.obj$foldchange)
+ pvals <- samr.pvalues.from.perms(samfit$samr.obj$tt, samfit$samr.obj$ttstar)
+ pvals[rowSums(exprs(e)) == 0] <- NA
+ padj <- p.adjust(pvals,method="BH")
+ padj[is.na(padj)] <- 1
+ list(pvals=pvals,padj=padj,beta=beta)
+}
+
+runSAMseqFDR <- function(e) {
+ set.seed(1)
+ x <- exprs(e)
+ y <- pData(e)$condition
+ capture.output({samfit <- SAMseq(x, y, resp.type = "Two class unpaired", fdr.output=1)})
+ padj <- rep(1,nrow(e))
+ idx <- as.numeric(samfit$siggenes.table$genes.up[,"Gene Name"])
+ padj[idx] <- 1/100 * as.numeric(samfit$siggenes.table$genes.up[,"q-value(%)"])
+ idx <- as.numeric(samfit$siggenes.table$genes.lo[,"Gene Name"])
+ padj[idx] <- 1/100 * as.numeric(samfit$siggenes.table$genes.lo[,"q-value(%)"])
+ beta <- log2(samfit$samr.obj$foldchange)
+ pvals <- rep(NA,nrow(e))
+ list(pvals=pvals,padj=padj,beta=beta)
+}
+
+runEBSeq <- function(e) {
+ sizes <- MedianNorm(exprs(e))
+ out <- capture.output({
+ suppressMessages({
+ res <- EBTest(Data = exprs(e),
+ Conditions = pData(e)$condition,
+ sizeFactors = sizes,
+ maxround = 5)
+ })
+ })
+ padj <- rep(1, nrow(exprs(e)))
+ # we use 1 - PPDE for the FDR cutoff as this is recommended in the EBSeq vignette
+ padj[match(rownames(res$PPMat), rownames(e))] <- res$PPMat[,"PPEE"]
+ beta <- rep(0, nrow(exprs(e)))
+ pvals <- rep(NA,nrow(e))
+ list(pvals=pvals, padj=padj, beta=beta)
+}
+
diff --git a/inst/script/simulateCluster.R b/inst/script/simulateCluster.R
new file mode 100644
index 0000000..281ff21
--- /dev/null
+++ b/inst/script/simulateCluster.R
@@ -0,0 +1,66 @@
+source("makeSim.R")
+load("meanDispPairs.RData")
+library("DESeq2")
+library("PoiClaClu")
+library("mclust")
+
+set.seed(1)
+n <- 2000
+# create 20 samples, then remove first group, leaving 16
+# this way the groups are equidistant from each other
+m <- 20
+k <- 4
+methods <- c("norm Eucl","log2 Eucl","rlog Eucl","VST Eucl","PoisDist")
+condition0 <- factor(rep(c("null","A","B","C","D"), each = m/(k+1)))
+x <- model.matrix(~ condition0)
+rnormsds <- list(seq(from=0, to=.6, length=7),
+ seq(from=0, to=.8, length=7),
+ seq(from=0, to=1.2, length=7))
+sfs <- list(equal=rep(1,m), unequal=rep(c(1,1,1/3,3), times=(k+1)))
+dispScales <- c(.1, .25, 1)
+nreps <- 20
+
+res <- do.call(rbind, lapply(seq_along(dispScales), function(idx) {
+ dispScale <- dispScales[idx]
+ do.call(rbind, lapply(rnormsds[[idx]], function(rnormsd) {
+ do.call(rbind, lapply(seq_along(sfs), function(sf.idx) {
+ sf <- sfs[[sf.idx]]
+ do.call(rbind, lapply(seq_len(nreps), function(i) {
+ beta <- replicate(k, c(rep(0,8/10 * n), rnorm(2/10 * n, 0, rnormsd)))
+ mdp <- meanDispPairs
+ mdp$disp <- mdp$disp * dispScale
+ mat0 <- makeSim(n,m,x,beta,mdp,sf)$mat
+ mat <- mat0[,5:20]
+ mode(mat) <- "integer"
+ condition <- droplevels(condition0[5:20])
+ dds <- DESeqDataSetFromMatrix(mat, DataFrame(condition), ~ 1)
+ dds <- estimateSizeFactors(dds)
+ dds <- estimateDispersionsGeneEst(dds)
+ # don't warn if local fit is used
+ dds <- suppressWarnings({estimateDispersionsFit(dds)})
+ norm <- t(counts(dds, normalized=TRUE))
+ lognorm <- t(log2(counts(dds, normalized=TRUE) + 1))
+ rld <- t(assay(rlog(dds, blind=FALSE)))
+ vsd <- t(assay(varianceStabilizingTransformation(dds, blind=FALSE)))
+ poiDist <- PoissonDistance(t(mat))$dd
+
+ normARI <- adjustedRandIndex(condition, cutree(hclust(dist(norm)),k=k))
+ lognormARI <- adjustedRandIndex(condition, cutree(hclust(dist(lognorm)),k=k))
+ rlogARI <- adjustedRandIndex(condition, cutree(hclust(dist(rld)),k=k))
+ vstARI <- adjustedRandIndex(condition, cutree(hclust(dist(vsd)),k=k))
+ poiDistARI <- adjustedRandIndex(condition, cutree(hclust(poiDist),k=k))
+
+ data.frame(ARI = c(normARI, lognormARI, rlogARI, vstARI, poiDistARI),
+ method = methods,
+ rnormsd = rep(rnormsd,length(methods)),
+ dispScale = rep(dispScale,length(methods)),
+ sizeFactor = rep(names(sfs)[sf.idx], length(methods)))
+ }))
+ }))
+ }))
+}))
+
+res$method <- factor(res$method, methods)
+
+save(res, file="results_simulateCluster.RData")
+
diff --git a/inst/script/simulateDE.R b/inst/script/simulateDE.R
new file mode 100644
index 0000000..bc1975a
--- /dev/null
+++ b/inst/script/simulateDE.R
@@ -0,0 +1,67 @@
+source("makeSim.R")
+load("meanDispPairs.RData")
+library("Biobase")
+library("DESeq2")
+library("edgeR")
+library("limma")
+library("samr")
+library("DSS")
+library("EBSeq")
+source("runScripts.R")
+algos <- list("DESeq2"=runDESeq2,
+ "edgeR"=runEdgeR,"edgeR-robust"=runEdgeRRobust,
+ "DSS"=runDSS,"DSS-FDR"=runDSSFDR,
+ "voom"=runVoom,
+ "SAMseq"=runSAMseq,"SAMseq-FDR"=runSAMseqFDR,
+ "EBSeq"=runEBSeq)
+namesAlgos <- names(algos)
+
+n <- 10000
+effSizeLevels <- log2(c(2,3,4))
+mLevels <- c(6,8,10,20)
+nreps <- 6
+
+effSizes <- rep(rep(effSizeLevels, each=nreps), times=length(mLevels))
+ms <- rep(mLevels, each=nreps * length(effSizeLevels))
+
+library("BiocParallel")
+register(SerialParam())
+#register(MulticoreParam(workers=8,verbose=TRUE))
+
+resList <- bplapply(seq_along(ms), function(i) {
+ set.seed(i)
+ m <- ms[i]
+ es <- effSizes[i]
+ condition <- factor(rep(c("A","B"), each = m/2))
+ x <- model.matrix(~ condition)
+ beta <- c(rep(0, n * 8/10), sample(c(-es,es), n * 2/10, TRUE))
+ mat <- makeSim(n,m,x,beta,meanDispPairs)$mat
+ e <- ExpressionSet(mat, AnnotatedDataFrame(data.frame(condition)))
+ resTest <- lapply(algos, function(f) f(e))
+ nonzero <- rowSums(exprs(e)) > 0
+ sensidx <- abs(beta) > 0 & nonzero
+ sens <- sapply(resTest, function(z) mean((z$padj < .1)[sensidx]))
+ rmf <- cut(rowMeans(mat), c(0, 20, 100, 300, Inf), include.lowest=TRUE)
+ levels(rmf) <- paste0("sens",c("0to20","20to100","100to300","more300"))
+ sensStratified <- t(sapply(resTest, function(z) tapply((z$padj < .1)[sensidx], rmf[sensidx], mean)))
+ oneminusspecpvals <- sapply(resTest, function(z) mean((z$pvals < .01)[beta == 0 & nonzero], na.rm=TRUE))
+ oneminusspecpadj <- sapply(resTest, function(z) mean((z$padj < .1)[beta == 0 & nonzero], na.rm=TRUE))
+ oneminusprec <- sapply(resTest, function(z) {
+ idx <- which(z$padj < .1)
+ ifelse(sum(idx) == 0, 0, mean((beta == 0)[idx]))
+ })
+ data.frame(sensitivity=sens,
+ sensStratified,
+ oneminusspecpvals=oneminusspecpvals,
+ oneminusspecpadj=oneminusspecpadj,
+ oneminusprec=oneminusprec,
+ algorithm=namesAlgos, effSize=es, m=m)
+})
+res <- do.call(rbind, resList)
+
+res$algorithm <- factor(res$algorithm, namesAlgos)
+
+sessInfo <- sessionInfo()
+
+save(res, namesAlgos, sessInfo, file="results_simulateDE.RData")
+
diff --git a/inst/script/simulateLFCAccuracy.R b/inst/script/simulateLFCAccuracy.R
new file mode 100644
index 0000000..d5a8b01
--- /dev/null
+++ b/inst/script/simulateLFCAccuracy.R
@@ -0,0 +1,67 @@
+source("makeSim.R")
+source("runScripts.R")
+load("meanDispPairs.RData")
+library("DESeq2")
+library("edgeR")
+library("Biobase")
+algos <- list("DESeq2"=runDESeq2,"edgeR"=runEdgeR)
+namesAlgos <- names(algos)
+
+set.seed(1)
+nreps <- 10
+n <- 1000
+ms <- c(4,6,10,16,20)
+types <- c("bell","slab bell","slab spike","spike spike")
+methods <- c("DESeq2","edgeR predFC","edgeR predFC10")
+res <- do.call(rbind, lapply(ms, function(m) {
+ do.call(rbind, lapply(types, function(type) {
+ do.call(rbind, lapply(seq_len(nreps), function(i) {
+ beta <- if (type == "bell") {
+ rnorm(n)
+ } else if (type == "slab bell") {
+ c(rnorm(n * 8/10), runif(n * 2/10, -4, 4))
+ } else if (type == "slab spike") {
+ beta <- c(rep(0, n * 8/10), runif(n * 2/10, -4, 4))
+ } else if (type == "spike spike") {
+ beta <- c(rep(0, n * 8/10), sample(c(-2, 2), n * 2/10, TRUE))
+ }
+ condition <- factor(rep(c("A","B"), each = m/2))
+ x <- model.matrix(~ condition)
+ mat <- makeSim(n,m,x,beta,meanDispPairs)$mat
+ e <- ExpressionSet(mat, AnnotatedDataFrame(data.frame(condition)))
+
+ res0 <- lapply(algos, function(f) f(e))
+ resdf <- do.call(rbind, lapply(methods, function(method) {
+ if (method == "edgeR predFC") {
+ predbeta <- res0[["edgeR"]]$predbeta
+ } else if (method == "edgeR predFC10") {
+ predbeta <- res0[["edgeR"]]$predbeta10
+ } else {
+ predbeta <- res0[[method]]$beta
+ }
+ SE <- ((beta - predbeta)^2)
+ AE <- abs(beta - predbeta)
+ nz <- rowSums(exprs(e)) > 0
+ de <- beta != 0
+ RMSE <- sqrt(mean(SE[nz]))
+ MAE <- mean(AE[nz])
+ DiffRMSE <- sqrt(mean(SE[nz & de]))
+ DiffMAE <- mean(AE[nz & de])
+ data.frame(RMSE=RMSE, MAE=MAE, DiffRMSE=DiffRMSE, DiffMAE)
+ }))
+
+ data.frame(m=rep(m, length(methods)),
+ type=rep(type, length(methods)),
+ method=methods,
+ RMSE=resdf$RMSE,
+ MAE=resdf$MAE,
+ DiffRMSE=resdf$DiffRMSE,
+ DiffMAE=resdf$DiffMAE)
+ }))
+ }))
+}))
+
+res$method <- factor(res$method, methods)
+
+save(res, file="results_simulateLFCAccuracy.RData")
+
diff --git a/inst/script/simulateOutliers.R b/inst/script/simulateOutliers.R
new file mode 100644
index 0000000..63f1088
--- /dev/null
+++ b/inst/script/simulateOutliers.R
@@ -0,0 +1,91 @@
+source("makeSim.R")
+load("meanDispPairs.RData")
+library("Biobase")
+library("DESeq2")
+library("edgeR")
+source("runScripts.R")
+algos <- list("DESeq2"=runDESeq2Outliers,
+ "edgeR"=runEdgeR,
+ "edgeR-robust"=runEdgeRRobust)
+namesAlgos <- names(algos)
+methods <- c("DESeq2", "DESeq2-noFilt", "DESeq2-noRepl", "edgeR", "edgeR-robust")
+
+set.seed(1)
+padjVector <- seq(from=0, to=1, length=201)
+pvalsVector <- seq(from=0, to=.4, length=201)
+n <- 4000
+percentOutliers <- seq(from=0,to=.15,length=4)
+ms <- c(10,20)
+nreps <- 10
+
+res <- do.call(rbind, lapply(ms, function(m) {
+ do.call(rbind, lapply(percentOutliers, function(pOut) {
+ resList <- lapply(seq_len(nreps), function(i) {
+ condition <- factor(rep(c("A","B"), each = m/2))
+ x <- model.matrix(~ condition)
+ beta <- c(rep(0, n * 8/10), sample(c(-1,1), n * 2/10, TRUE))
+ mat <- makeSim(n,m,x,beta,meanDispPairs)$mat
+ idx.i <- sample(n, round(n*pOut))
+ idx.j <- sample(m, round(n*pOut), TRUE)
+ mat[cbind(idx.i,idx.j)] <- mat[cbind(idx.i,idx.j)] * 100
+ e <- ExpressionSet(mat, AnnotatedDataFrame(data.frame(condition)))
+ resTest0 <- lapply(algos, function(f) f(e))
+ # this avoids re-running DESeq2 without filtering or replacement
+ resTest <- list()
+ resTest[names(resTest0[["DESeq2"]])] <- resTest0[["DESeq2"]]
+ resTest[c("edgeR","edgeR-robust")] <- resTest0[c("edgeR","edgeR-robust")]
+ resTest[["beta"]] <- beta
+ resTest[["nonzero"]] <- rowSums(exprs(e)) > 0
+ resTest
+ })
+ sens <- sapply(methods, function(method) {
+ sensMat <- sapply(seq_along(resList), function(i) {
+ sapply(pvalsVector, function(p) {
+ idx <- resList[[i]][["beta"]] != 0 & resList[[i]][["nonzero"]]
+ mean((resList[[i]][[method]]$pvals < p)[idx])
+ })
+ })
+ apply(sensMat, 1, median)
+ })
+ spec <- sapply(methods, function(method) {
+ specMat <- sapply(seq_along(resList), function(i) {
+ sapply(pvalsVector, function(p) {
+ idx <- resList[[i]][["beta"]] == 0 & resList[[i]][["nonzero"]]
+ mean((resList[[i]][[method]]$pvals >= p)[idx])
+ })
+ })
+ apply(specMat, 1, median)
+ })
+ senspadj <- sapply(methods, function(method) {
+ padjMat <- sapply(seq_along(resList), function(i) {
+ sapply(pvalsVector, function(p) {
+ idx <- resList[[i]][["nonzero"]]
+ smallp <- resList[[i]][[method]]$pvals[idx] < p
+ if (sum(smallp) == 0) 0 else max(resList[[i]][[method]]$padj[idx][ smallp ])
+ })
+ })
+ apply(padjMat, 1, median)
+ })
+ prec <- sapply(methods, function(method) {
+ precMat <- sapply(seq_along(resList), function(i) {
+ sapply(padjVector, function(p) {
+ idx <- resList[[i]][[method]]$padj < p
+ if (sum(idx) == 0) 1 else mean( (resList[[i]][["beta"]] != 0)[idx] )
+ })
+ })
+ apply(precMat, 1, median)
+ })
+ data.frame(sensitivity = as.vector(sens),
+ pvals = rep(pvalsVector, times=length(methods)),
+ senspadj = as.vector(senspadj),
+ oneminusspec = 1 - as.vector(spec),
+ oneminusprec = 1 - as.vector(prec),
+ precpadj = rep(padjVector, times=length(methods)),
+ algorithm = rep(methods, each=length(pvalsVector)),
+ m = rep(m, length(methods) * length(pvalsVector)),
+ percentOutlier = rep(pOut, length(methods) * length(pvalsVector)))
+ }))
+}))
+
+save(res, file="results_simulateOutliers.RData")
+
diff --git a/inst/script/simulation.Rmd b/inst/script/simulation.Rmd
new file mode 100644
index 0000000..1bb7e1d
--- /dev/null
+++ b/inst/script/simulation.Rmd
@@ -0,0 +1,397 @@
+# Assessment of DESeq2 through simulation
+
+Michael Love, Wolfgang Huber, Simon Anders
+
+<!-- this document built with knit() in R -->
+<!-- pandoc -o simulation.pdf simulation.md -->
+
+```{r options, echo=FALSE, results="hide"}
+opts_chunk$set(dev="pdf")
+```
+
+Document compiled on:
+
+```{r time, echo=FALSE}
+Sys.time()
+```
+
+This document and associated files provide the code and plots for the
+simulation section of the *DESeq2* paper, so that these results can be
+easily updated over time. For more details, read the paper at the
+following URL:
+
+http://dx.doi.org/10.1101/002832
+
+## Differential expression analysis
+
+We assessed the sensitivity and specificity of various algorithms
+using simulation to complement an analysis on real data. The following
+Negative Binomial simulation samples (mean, dispersion) pairs from the
+joint distribution of estimated means and dispersions from the Pickrell
+et al dataset. The true differences between two groups are drawn from
+either *z*, *0* or *-z*, where the *0* component represents 80% of the
+genes. The absolute value of the effect size *z* for the 20% of genes
+with differential expression is varied, as is the total sample size m
+(such that each group has m/2 samples). 10,000 genes were simulated,
+and each combination of parameters was repeated 6 times. The code to
+generate these results is in `simulateDE.R` and the code to run each
+algorithm is in `runScripts.R`.
+
+Note: *DSS* denotes running *DSS* and then Benjamini-Hochberg
+adjustment on *p*-values. *DSS-FDR* denotes the native FDR estimation
+of the *DSS* software.
+*SAMseq* denotes running *SAMseq* with *p*-value
+estimation and Benjamini-Hochberg adjustment for FDR.
+*SAMseq-FDR* denotes the native FDR estimation and no *p*-value
+estimation. *EBSeq* likewise only produces FDR.
+
+```{r loadDE}
+load("results_simulateDE.RData")
+res$m <- factor(res$m)
+levels(res$m) <- paste0("m=",levels(res$m))
+res$effSize <- factor(res$effSize)
+levels(res$effSize) <- c("fold change 2","fold change 3","fold change 4")
+res$algorithm <- factor(res$algorithm)
+resClean <- res[!is.na(res$oneminusspecpvals),]
+```
+
+```{r simulateDE, fig.width=7, fig.height=5, fig.cap="Sensitivity and specificity on simulated datasets."}
+library("ggplot2")
+p <- ggplot(resClean, aes(y=sensitivity, x=oneminusspecpvals,
+ color=algorithm, shape=algorithm))
+p + geom_point() + theme_bw() + facet_grid(effSize ~ m) +
+ scale_shape_manual(values=1:9) +
+ xlab("1 - specificity (false positive rate)") +
+ coord_cartesian(xlim=c(-.003,.035)) +
+ geom_vline(xintercept=.01) +
+ scale_x_continuous(breaks=c(0,.02))
+```
+
+Use of simulation to assess the sensitivity and specificity of
+algorithms across combinations of sample size and effect size. The
+sensitivity was calculated as the fraction of genes with adjusted
+*p*-value less than 0.1 among the genes with true differences between
+group means. The specificity was calculated as the fraction of genes
+with *p*-value greater than 0.01 among the genes with no true
+differences between group means. The *p*-value was chosen instead of
+the adjusted *p*-value, as this allows for comparison against the
+expected fraction of *p*-values less than a critical value given the
+uniformity of *p*-values under the null hypothesis.
+
+```{r simulateDEPrec, fig.width=7, fig.height=5, fig.cap="Sensitivity and precision on simulated datasets."}
+library("ggplot2")
+p <- ggplot(res, aes(y=sensitivity, x=oneminusprec,
+ color=algorithm, shape=algorithm))
+p + geom_point() + theme_bw() + facet_grid(effSize ~ m) +
+ scale_shape_manual(values=1:9) +
+ xlab("1 - precision (false discovery rate)") +
+ coord_cartesian(xlim=c(-.03, .3)) +
+ geom_vline(xintercept=.1)
+```
+
+Sensitivity and precision of algorithms across combinations of sample
+size and effect size. The sensitivity was calculated as the fraction
+of genes with adjusted *p*-value less than 0.1 among the genes with true
+differences between group means. The precision was calculated as the
+fraction of genes with true differences between group means among
+those with adjusted *p*-value less than 0.1.
+
+```{r simulateDESensStratify, fig.width=7, fig.height=5, fig.cap="Sensitivity dependence on mean count."}
+library("reshape")
+id.vars <- c("algorithm","effSize","m")
+measure.vars <- c("sens0to20","sens20to100","sens100to300","sensmore300")
+melted <- melt(res[,c(id.vars,measure.vars)], id.vars=id.vars,
+ measure.vars=measure.vars)
+names(melted) <- c(id.vars, "aveexp", "sensitivity")
+levels(melted$aveexp) <- c("<20","20-100","100-300",">300")
+p <- ggplot(melted, aes(y=sensitivity, x=aveexp, group=algorithm,
+ color=algorithm, shape=algorithm))
+p + stat_summary(fun.y="mean", geom="line") +
+ stat_summary(fun.y="mean", geom="point") +
+ theme_bw() + facet_grid(effSize ~ m) +
+ scale_shape_manual(values=1:9) +
+ theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
+ xlab("mean counts")
+```
+
+The sensitivity of algorithms across combinations of sample size and
+effect size, and further stratified by the mean of counts of the
+differentially expressed genes in the simulation data. Points indicate
+the average over 6 replicates. Algorithms all show a similar
+dependence of sensitivity on the mean of counts. The height of the
+sensitivity curve should be compared with the previous plot indicating
+the total sensitivity and specificity of each algorithm.
+
+## Performance in the presence of outliers
+
+The following plots examine the affect of outliers on differential
+calls by the two Negative-Binomial-based methods *DESeq2* and *edgeR*.
+*DESeq2* was run with default settings, after turning off
+gene filtering, and after turning off outlier replacement. *edgeR*
+was run with default settings, and after using the *robust* option.
+The code to generate these results is in `simulateOutliers.R`.
+
+```{r loadOut}
+load("results_simulateOutliers.RData")
+# when < 7 replicates DESeq does not replace
+res <- res[!(res$algorithm == "DESeq2-noRepl" & res$m < 14),]
+# when >= 7 replicates DESeq does not filter
+res <- res[!(res$algorithm == "DESeq2-noFilt" & res$m >= 14),]
+res$m <- factor(res$m)
+levels(res$m) <- paste0("m=",levels(res$m))
+res$percentOutlier <- 100 * res$percentOutlier
+res$percentOutlier <- factor(res$percentOutlier)
+levels(res$percentOutlier) <- paste0(levels(res$percentOutlier),"% outlier")
+```
+
+Because the sensitivity-specificity curve is evaluated using the p
+value, we use fhe following code to pick out the point on the
+sensitivity-specificity curve with largest p value such that the
+nominal adjusted *p*-value is less than 0.1.
+
+```{r}
+resSensPadj <- res[res$senspadj < .1,]
+resSensPadj <- resSensPadj[nrow(resSensPadj):1,]
+resSensPadj <- resSensPadj[!duplicated(with(resSensPadj,
+ paste(algorithm, m, percentOutlier))),]
+summary(resSensPadj$senspadj)
+```
+
+```{r simulateOutliersSens, fig.width=8, fig.height=4, fig.cap="Sensitivity and specificity in presence of outliers."}
+library("ggplot2")
+p <- ggplot(res, aes(x=oneminusspec, y=sensitivity, color=algorithm))
+p + scale_x_continuous(breaks=c(0,.1,.2)) +
+ scale_y_continuous(breaks=c(0,.2,.4,.6,.8)) +
+ geom_line() + theme_bw() +
+ facet_grid(m ~ percentOutlier) + xlab("1 - specificity") +
+ coord_cartesian(xlim=c(-.03, .25), ylim=c(-.05, .9)) +
+ geom_point(aes(x=oneminusspec, y=sensitivity, shape=algorithm),
+ data=res[res$precpadj == .1,])
+```
+
+Sensitivity-specificity curves for detecting true differences in the
+presence of outliers. Negative Binomial counts were simulated for 4000
+genes and total sample sizes (m) of 10 and 20, for a two-group
+comparison. 80% of the simulated genes had no true differential
+expression, while for 20% of the genes true logarithmic (base 2)
+fold changes of -1 or 1. The number of genes with simulated outliers
+was increased from 0% to 15%. The outliers were constructed for a
+gene by multiplying the count of a single sample by 100. Sensitivity
+and specificity were calculated by thresholding on *p*-values. Points
+indicate an adjusted *p*-value of 0.1. DESeq2 filters genes with
+potential outliers for samples with 3 to 6 replicates, while replacing
+outliers for samples with 7 or more replicates, hence the filtering
+can be turned off for the top row (m=10) and the replacement can be
+turned off for the bottom row (m=20).
+
+```{r simulateOutliersPrec, fig.width=8, fig.height=4, fig.cap="FDR and target FDR in presence of outliers."}
+p <- ggplot(res, aes(x=precpadj, y=oneminusprec, color=algorithm))
+p + scale_x_continuous(breaks=c(0,.1,.2)) +
+ scale_y_continuous(breaks=c(0,.1,.2)) +
+ geom_line() + theme_bw() +
+ facet_grid(m ~ percentOutlier) +
+ geom_abline(intercept=0,slope=1) +
+ xlab("adjusted *p*-value") + ylab("1 - precision (FDR)") +
+ coord_cartesian(xlim=c(-.03, .25), ylim=c(-.05, .25)) +
+ geom_point(aes(x=precpadj, y=oneminusprec, shape=algorithm),
+ data=res[res$precpadj == .1,])
+```
+
+Outlier handling: One minus the precision (false discovery rate)
+plotted over various thresholds of adjusted *p*-value. Shown is the
+results for the same simulation with outliers described in the
+previous figure. Points indicate an adjusted *p*-value of 0.1.
+
+## Accuracy of log fold change estimates
+
+The following simulations used Negative Binomial random variables
+with mean and dispersion pairs samples from the joint
+distribution of mean-dispersion estimates from the Pickrell data. In
+addition, true differences between two groups were randomly generated,
+according to the following models, diagrammed below. The
+accuracy of four methods for estimating the log fold change between
+groups were compared by the root mean squared error (RMSE) and the
+mean absolute error (MAE). The four methods were chosen for their
+particular focus on the logs fold change estimate.
+The code to generate these results is in `simulateLFCAccuracy.R`.
+
+```{r lfcAccuracyHist, fig.width=6, fig.height=6, fig.cap="Examples of simulated log2 fold changes."}
+par(mfrow=c(2,2),mar=c(3,3,3,1))
+n <- 1000
+brks <- seq(from=-4,to=4,length.out=20)
+trimit <- function(x) x[x > -4 & x < 4] # for visualization only
+myhist <- function(x, ...) hist(x, breaks=brks, border="white",
+ col="blue", xlab="", ylab="", ...)
+myhist(trimit(rnorm(n)), main="bell")
+myhist(trimit(c(rnorm(n * 8/10), runif(n * 2/10, -4, 4))), main="slab bell")
+myhist(c(rep(0, n * 8/10), runif(n * 2/10, -4, 4)), main="slab spike")
+myhist(c(rep(0, n * 8/10), sample(c(-2, 2), n * 2/10, TRUE)), main="spike spike")
+```
+
+Benchmarking LFC estimation: Models for simulating logarithmic (base
+2) fold changes. For the bell model, true logarithmic fold changes
+were drawn from a Normal with mean 0 and variance 1. For the slab bell
+model, true logarithmic fold changes were drawn for 80% of genes
+from a Normal with mean 0 and variance 1 and for 20% of genes from a
+Uniform distribution with range from -4 to 4. For the slab spike
+model, true logarithmic fold changes were drawn similarly to the slab
+bell model except the Normal is replaced with a spike of logarithmic
+fold changes at 0. For the spike spike model, true logarithmic fold
+changes were drawn according to a spike of logarithmic fold changes at
+0 (80%) and a spike randomly sampled from -2 or 2 (20%). These
+spikes represent fold changes of 1/4 and 4, respectively.
+
+```{r lfcAccuracy, fig.width=7, fig.height=5, fig.cap="Root mean squared error in estimating log2 fold changes."}
+load("results_simulateLFCAccuracy.RData")
+library("ggplot2")
+library("Hmisc")
+p <- ggplot(data=res, aes(x=m, y=RMSE, color=method, shape=method))
+p + stat_summary(fun.y=mean, geom="point") +
+ stat_summary(fun.y=mean, geom="line") +
+ stat_summary(fun.data=mean_cl_normal, geom="errorbar") +
+ theme_bw() + xlab("total sample size") + facet_wrap(~ type) +
+ scale_x_continuous(breaks=unique(res$m))
+```
+
+Root mean squared error (RMSE) for estimating logarithmic fold changes
+under the four models of logarithmic fold changes and varying total
+sample size m. Simulated Negative Binomial counts were generated for
+two groups and for 1000 genes. Points and error bars are drawn for the
+mean and 95% confidence interval over 10 replications.
+
+```{r lfcAccuracyDE, fig.width=6, fig.height=2.5, fig.cap="Root mean squared error for only differentially expressed genes."}
+p <- ggplot(data=res[grepl("spike",res$type),],
+ aes(x=m, y=DiffRMSE, color=method, shape=method))
+p + stat_summary(fun.y=mean, geom="point") +
+ stat_summary(fun.y=mean, geom="line") +
+ stat_summary(fun.data=mean_cl_normal, geom="errorbar") +
+ theme_bw() + xlab("total sample size") + ylab("RMSE only of DE genes") +
+ facet_wrap(~ type) +
+ scale_x_continuous(breaks=unique(res$m))
+```
+
+Root mean squared error (RMSE) of logarithmic fold change estimates,
+only considering genes with non-zero true logarithmic fold change. For
+the same simulation, shown here is the error only for the 20% of
+genes with non-zero true logarithmic fold changes (for bell and slab
+bell all genes have non-zero logarithmic fold change).
+
+```{r lfcAccuracyMAE, fig.width=7, fig.height=5, fig.cap="Mean absolute error in estimating log2 fold changes."}
+p <- ggplot(data=res, aes(x=m, y=MAE, color=method, shape=method))
+p + stat_summary(fun.y=mean, geom="point") +
+ stat_summary(fun.y=mean, geom="line") +
+ stat_summary(fun.data=mean_cl_normal, geom="errorbar") +
+ theme_bw() + xlab("total sample size") + ylab("MAE") +
+ facet_wrap(~ type) +
+ scale_x_continuous(breaks=unique(res$m))
+```
+
+Mean absolute error (MAE) of logarithmic fold change
+estimates. Results for the same simulation, however here using median
+absolute error in place of root mean squared error. Mean absolute
+error places less weight on the largest errors.
+
+```{r lfcAccuracyDiffMAE, fig.width=6, fig.height=2.5, fig.cap="Mean absolute error for only differentially expressed genes."}
+p <- ggplot(data=res[grepl("spike",res$type),],
+ aes(x=m, y=DiffMAE, color=method, shape=method))
+p + stat_summary(fun.y=mean, geom="point") +
+ stat_summary(fun.y=mean, geom="line") +
+ stat_summary(fun.data=mean_cl_normal, geom="errorbar") +
+ theme_bw() + xlab("total sample size") + ylab("MAE only of DE genes") +
+ facet_wrap(~ type) +
+ scale_x_continuous(breaks=unique(res$m))
+```
+
+Mean absolute error (MAE) of logarithmic fold change estimates, only
+considering those genes with non-zero true logarithmic fold change.
+
+
+## Transformations and distances for recovery of true clusters
+
+The following simulation evaluated a set of methods for
+transformation, and for calculating distances betweeen vectors of
+counts, for their performance in recapturing true clusters in
+simulated data. Negative Binomial counts were generated in
+four groups, each with four samples. These groups were generated with
+20% of genes given Normally-distributed log fold changes from a centroid.
+The standard deviation of the Normal for the non-null genes
+was varied to make the clustering easier or more difficult.
+The mean of the centroid and
+the dispersion of the counts were drawn as pairs from the joint
+distribution of estimates from the Pickrell et al
+dataset. As the Pickrell dataset has high dispersion (RNA-Seq counts
+of lymphoblast cells across a population of individuals), simulations
+were also considered wherein the dispersion was 0.1 and 0.25 times the
+Pickrell dispersions. Hierarchical clustering with complete linkage was
+used to separate the samples into four predicted clusters, using a
+variety of combinations of transformation and distance. These
+predicted clusters were then compared to the true clusters according to
+the simulation using the adjusted Rand Index. Furthermore, two
+variations were considered, one in which the size factors between
+conditions were equal and one in which the size factors within each
+group were [1, 1, 1/3, 3].
+The code to generate these results is in `simulateCluster.R`.
+
+```{r simulateCluster, fig.width=8, fig.height=5, fig.cap="Clustering accuracy over the size of group differences."}
+load("results_simulateCluster.RData")
+library("ggplot2")
+library("Hmisc")
+res$sizeFactor <- factor(res$sizeFactor)
+levels(res$sizeFactor) <- paste("size factors", levels(res$sizeFactor))
+res$dispScale <- factor(res$dispScale)
+levels(res$dispScale) <- paste(levels(res$dispScale),"x dispersion")
+p <- ggplot(res, aes(x=rnormsd, y=ARI, color=method, shape=method))
+p + stat_summary(fun.y=mean, geom="point", aes(shape=method)) +
+ stat_summary(fun.y=mean, geom="line") +
+ stat_summary(fun.data=mean_cl_normal, geom="errorbar") +
+ facet_grid(sizeFactor ~ dispScale, scale="free") + theme_bw() +
+ ylab("adjusted Rand Index") + xlab("SD of group differences")
+```
+
+Adjusted Rand Index from clusters using various transformation and
+distances compared to the true clusters from simulation. The methods
+assessed were Euclidean distance on counts normalized by size factor,
+log2 of normalized counts plus a pseudocount of 1, and after applying
+the rlog and variance stabilizing transformation. Additionally, the
+Poisson Distance from the PoiClaClu package was used for hierarchical
+clustering. The points indicate the mean from 20 simulations and the
+bars are 95 percent confidence intervals.
+
+## Genes expressed in only one condition
+
+As discussed by
+[Robinson and Smyth](http://biostatistics.oxfordjournals.org/content/9/2/321.long)
+and by [Rapaport et al.](http://genomebiology.com/2013/14/9/R95),
+it is desirable that, in the situation in which a gene is only
+expressed in one condition, the statistical significance increase with
+the signal to noise ratio of expression in the expressed condition.
+For example, Rapaport et al. plot the $-\log_{10}(p)$ for *p* values over
+the signal to noise ratio.
+In the following code chunk we demontrate that *DESeq2* has increasing
+$-\log_{10}(p)$ in a comparison of two conditions in which one group
+has all zero counts, e.g.: $\{0,0,0\}$ vs $\{10,10,10\}$.
+
+```{r onlyonecondition, fig.width=4, fig.height=4, fig.cap="Simulated gene expressed in only one condition"}
+m <- 6
+disp <- 0.5
+ii <- seq(from=1,to=4,length=7)
+coldata <- DataFrame(x=factor(rep(1:2,each=m/2)))
+pvals <- sapply(ii, function(i) {
+ mat <- matrix(as.integer(c(rep(0,m/2),rep(10^i,m/2))),nrow=1)
+ dds <- DESeqDataSetFromMatrix(mat, coldata, ~ x)
+ sizeFactors(dds) <- rep(1,m)
+ dispersions(dds) <- disp
+ results(nbinomWaldTest(dds))$pvalue
+})
+plot(10^ii, -log10(pvals), log="x", type="b", xaxt="n",
+ xlab="group 2 counts", ylab=expression(-log[10](p~value)))
+axis(1,10^(1:4),10^(1:4))
+```
+
+## Session information
+
+The session information saved in the `simulateDE` script:
+
+```{r}
+sessInfo
+```
diff --git a/inst/script/simulation.pdf b/inst/script/simulation.pdf
new file mode 100644
index 0000000..164a24a
Binary files /dev/null and b/inst/script/simulation.pdf differ
diff --git a/inst/script/testsuite.Rmd b/inst/script/testsuite.Rmd
new file mode 100644
index 0000000..6c5ff62
--- /dev/null
+++ b/inst/script/testsuite.Rmd
@@ -0,0 +1,173 @@
+# Test suite
+
+```{r functionDefs}
+
+medianPercentShrinkage <- function(res,...) {
+ idx <- res$baseMean > 10
+ baseMean <- res$baseMean[idx]
+ qs <- quantile(baseMean, 0:10/10)
+ nms <- unname( round( (qs[-1] + qs[-length(qs)])/2 ) )
+ f <- cut(baseMean, qs)
+ delta <- 100 * ( (res$lfcMLE - res$log2FoldChange) / res$lfcMLE )[ idx ]
+ barplot(tapply(delta, f, median, na.rm=TRUE), las=2,
+ names=nms, xlab="mean expression", ylab="median percent LFC shrinkage",
+ ...)
+}
+
+summarizeDESeqRun <- function(x,Wald=TRUE) {
+ name <- x$name
+ time <- x$time
+ res <- x$res
+ dds <- x$dds
+ cat(name,"\n")
+ cat(paste(as.character(design(dds)),collapse=""),"\n")
+ cat(paste(nrow(dds),"genes",ncol(dds),"samples \n"))
+ cat(paste(round(unname(time[3])),"seconds \n"))
+ summary(res)
+ if (Wald) {
+ par(mfrow=c(2,2))
+ yext <- max(abs(res$log2FoldChange),na.rm=TRUE)
+ plotMA(res,ylim=c(-yext,yext),main=name)
+ medianPercentShrinkage(res,main=name)
+ } else {
+ par(mfrow=c(1,2))
+ }
+ plotDispEsts(dds,main=name)
+ hist(res$pvalue[res$baseMean > 10],col="grey",main="p-values | base-mean > 10",xlab="")
+}
+
+library("GenomicRanges")
+
+recount2SE <- function(name) {
+ filename <- paste0(name,"_eset.RData")
+ if (!file.exists(filename)) download.file(paste0(
+ "http://bowtie-bio.sourceforge.net/recount/ExpressionSets/",
+ filename),filename)
+ load(filename)
+ e <- get(paste0(name,".eset"))
+ se <- SummarizedExperiment(SimpleList(counts=exprs(e)),
+ colData=DataFrame(pData(e)))
+ se
+}
+
+```
+
+
+```{r runAirway, cache=TRUE}
+library("airway")
+data(airway)
+dds <- DESeqDataSet(airway, ~ cell + dex)
+time <- system.time({ dds <- DESeq(dds) })
+res <- results(dds,addMLE=TRUE)
+airwayRes <- list(name="airway", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+
+```{r runPasilla, cache=TRUE}
+library("pasilla")
+library("Biobase")
+data("pasillaGenes")
+countData <- counts(pasillaGenes)
+colData <- pData(pasillaGenes)[,c("condition","type")]
+dds <- DESeqDataSetFromMatrix(countData = countData,
+ colData = colData,
+ design = ~ type + condition)
+dds$condition <- relevel(dds$condition, "untreated","treated")
+time <- system.time({ dds <- DESeq(dds) })
+res <- results(dds,addMLE=TRUE)
+pasillaRes <- list(name="pasilla", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+```{r runHammer, cache=TRUE}
+se <- recount2SE("hammer")
+se$Time[4] <- "2 months"
+se$Time <- droplevels(se$Time)
+dds <- DESeqDataSet(se, ~ Time + protocol)
+dds$protocol <- relevel(dds$protocol, "control")
+time <- system.time({ dds <- DESeq(dds) })
+res <- results(dds,addMLE=TRUE)
+hammerRes <- list(name="hammer", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+```{r runBottomly, cache=TRUE}
+se <- recount2SE("bottomly")
+dds <- DESeqDataSet(se, ~ strain)
+time <- system.time({ dds <- DESeq(dds) })
+res <- results(dds,addMLE=TRUE)
+bottomlyRes <- list(name="bottomly", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+
+```{r runParathyroid, cache=TRUE}
+library("DESeq2")
+library("parathyroidSE")
+data(parathyroidGenesSE)
+se <- parathyroidGenesSE
+dds0 <- DESeqDataSet(se, ~ patient + treatment)
+dds0 <- dds0[,dds0$treatment != "OHT" & dds0$time == "48h"]
+dds <- collapseReplicates(dds0, groupby = dds0$sample, run = dds0$run)
+dds$treatment <- factor(dds$treatment, levels=c("Control","DPN"))
+time <- system.time({ dds <- DESeq(dds) })
+res <- results(dds,addMLE=TRUE)
+parathyroidRes <- list(name="parathyroid", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+```{r runFission, cache=TRUE}
+library("fission")
+data(fission)
+dds <- DESeqDataSet(fission, ~ strain + minute + strain:minute)
+time <- system.time({ dds <- DESeq(dds, test="LRT", reduced= ~ strain + minute) })
+res <- results(dds)
+fissionRes <- list(name="fission", time=time, res=res, dds=dds)
+rm(time, res, dds)
+```
+
+```{r plotAirway, fig.width=9, fig.height=9}
+summarizeDESeqRun(airwayRes)
+```
+
+```{r plotPasilla, fig.width=9, fig.height=9}
+summarizeDESeqRun(pasillaRes)
+```
+
+```{r plotHammer, fig.width=9, fig.height=9}
+summarizeDESeqRun(hammerRes)
+```
+
+```{r plotBottomly, fig.width=9, fig.height=9}
+summarizeDESeqRun(bottomlyRes)
+```
+
+
+```{r plotParathryoid, fig.width=9, fig.height=9}
+summarizeDESeqRun(parathyroidRes)
+```
+
+```{r plotFission, fig.width=9, fig.height=4}
+summarizeDESeqRun(fissionRes, Wald=FALSE)
+```
+
+```{r, fig.width=5, fig.height=5}
+gene <- rownames(fissionRes$res)[which.min(fissionRes$res$pvalue)]
+data <- plotCounts(fissionRes$dds, gene, intgroup=c("minute","strain"),
+ returnData=TRUE, transform=TRUE)
+library("ggplot2")
+ggplot(data, aes(minute, count, color=strain, group=strain)) +
+ ylab("log2 count") + geom_point() + geom_smooth(se=FALSE,method="loess") +
+ ggtitle(gene)
+```
+
+```{r}
+sapply(list(airway=airwayRes, pasilla=pasillaRes, hammer=hammerRes,
+ bottomly=bottomlyRes, parathyroid=parathyroidRes, fission=fissionRes),
+ function(z) unname(z$time[3]))
+```
+
+```{r}
+sessionInfo()
+```
diff --git a/man/DESeq.Rd b/man/DESeq.Rd
new file mode 100644
index 0000000..e5ae5ba
--- /dev/null
+++ b/man/DESeq.Rd
@@ -0,0 +1,178 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{DESeq}
+\alias{DESeq}
+\title{Differential expression analysis based on the Negative Binomial (a.k.a. Gamma-Poisson) distribution}
+\usage{
+DESeq(object, test = c("Wald", "LRT"), fitType = c("parametric", "local",
+ "mean"), betaPrior, full = design(object), reduced, quiet = FALSE,
+ minReplicatesForReplace = 7, modelMatrixType, parallel = FALSE,
+ BPPARAM = bpparam())
+}
+\arguments{
+\item{object}{a DESeqDataSet object, see the constructor functions
+\code{\link{DESeqDataSet}},
+\code{\link{DESeqDataSetFromMatrix}},
+\code{\link{DESeqDataSetFromHTSeqCount}}.}
+
+\item{test}{either "Wald" or "LRT", which will then use either
+Wald significance tests (defined by \code{\link{nbinomWaldTest}}),
+or the likelihood ratio test on the difference in deviance between a
+full and reduced model formula (defined by \code{\link{nbinomLRT}})}
+
+\item{fitType}{either "parametric", "local", or "mean"
+for the type of fitting of dispersions to the mean intensity.
+See \code{\link{estimateDispersions}} for description.}
+
+\item{betaPrior}{whether or not to put a zero-mean normal prior on
+the non-intercept coefficients
+See \code{\link{nbinomWaldTest}} for description of the calculation
+of the beta prior. By default, the beta prior is used only for the
+Wald test, but can also be specified for the likelihood ratio test.}
+
+\item{full}{for \code{test="LRT"}, the full model formula,
+which is restricted to the formula in \code{design(object)}.
+alternatively, it can be a model matrix constructed by the user.
+advanced use: specifying a model matrix for full and \code{test="Wald"}
+is possible if \code{betaPrior=FALSE}}
+
+\item{reduced}{for \code{test="LRT"}, a reduced formula to compare against,
+i.e., the full formula with the term(s) of interest removed.
+alternatively, it can be a model matrix constructed by the user}
+
+\item{quiet}{whether to print messages at each step}
+
+\item{minReplicatesForReplace}{the minimum number of replicates required
+in order to use \code{\link{replaceOutliers}} on a
+sample. If there are samples with so many replicates, the model will
+be refit after these replacing outliers, flagged by Cook's distance.
+Set to \code{Inf} in order to never replace outliers.}
+
+\item{modelMatrixType}{either "standard" or "expanded", which describe
+how the model matrix, X of the GLM formula is formed.
+"standard" is as created by \code{model.matrix} using the
+design formula. "expanded" includes an indicator variable for each
+level of factors in addition to an intercept. for more information
+see the Description of \code{\link{nbinomWaldTest}}.
+betaPrior must be set to TRUE in order for expanded model matrices
+to be fit.}
+
+\item{parallel}{if FALSE, no parallelization. if TRUE, parallel
+execution using \code{BiocParallel}, see next argument \code{BPPARAM}.
+A note on running in parallel using \code{BiocParallel}: it may be
+advantageous to remove large, unneeded objects from your current
+R environment before calling \code{DESeq},
+as it is possible that R's internal garbage collection
+will copy these files while running on worker nodes.}
+
+\item{BPPARAM}{an optional parameter object passed internally
+to \code{\link{bplapply}} when \code{parallel=TRUE}.
+If not specified, the parameters last registered with
+\code{\link{register}} will be used.}
+}
+\value{
+a \code{\link{DESeqDataSet}} object with results stored as
+metadata columns. These results should accessed by calling the \code{\link{results}}
+function. By default this will return the log2 fold changes and p-values for the last
+variable in the design formula. See \code{\link{results}} for how to access results
+for other variables.
+}
+\description{
+This function performs a default analysis through the steps:
+\enumerate{
+\item estimation of size factors: \code{\link{estimateSizeFactors}}
+\item estimation of dispersion: \code{\link{estimateDispersions}}
+\item Negative Binomial GLM fitting and Wald statistics: \code{\link{nbinomWaldTest}}
+}
+For complete details on each step, see the manual pages of the respective
+functions. After the \code{DESeq} function returns a DESeqDataSet object,
+results tables (log2 fold changes and p-values) can be generated
+using the \code{\link{results}} function. See the manual page
+for \code{\link{results}} for information on independent filtering and
+p-value adjustment for multiple test correction.
+}
+\details{
+The differential expression analysis uses a generalized linear model of the form:
+
+\deqn{ K_{ij} \sim \textrm{NB}( \mu_{ij}, \alpha_i) }{ K_ij ~ NB(mu_ij, alpha_i) }
+\deqn{ \mu_{ij} = s_j q_{ij} }{ mu_ij = s_j q_ij }
+\deqn{ \log_2(q_{ij}) = x_{j.} \beta_i }{ log2(q_ij) = x_j. beta_i }
+
+where counts \eqn{K_{ij}}{K_ij} for gene i, sample j are modeled using
+a Negative Binomial distribution with fitted mean \eqn{\mu_{ij}}{mu_ij}
+and a gene-specific dispersion parameter \eqn{\alpha_i}{alpha_i}.
+The fitted mean is composed of a sample-specific size factor
+\eqn{s_j}{s_j} and a parameter \eqn{q_{ij}}{q_ij} proportional to the
+expected true concentration of fragments for sample j.
+The coefficients \eqn{\beta_i}{beta_i} give the log2 fold changes for gene i for each
+column of the model matrix \eqn{X}{X}.
+The sample-specific size factors can be replaced by
+gene-specific normalization factors for each sample using
+\code{\link{normalizationFactors}}.
+
+For details on the fitting of the log2 fold changes and calculation of p-values,
+see \code{\link{nbinomWaldTest}} if using \code{test="Wald"},
+or \code{\link{nbinomLRT}} if using \code{test="LRT"}.
+
+Experiments without replicates do not allow for estimation of the dispersion
+of counts around the expected value for each group, which is critical for
+differential expression analysis. If an experimental design is
+supplied which does not contain the necessary degrees of freedom for differential
+analysis, \code{DESeq} will provide a message to the user and follow
+the strategy outlined in Anders and Huber (2010)
+under the section 'Working without replicates', wherein all the samples
+are considered as replicates of a single group for the estimation of dispersion.
+As noted in the reference above: "Some overestimation of the variance
+may be expected, which will make that approach conservative."
+Furthermore, "while one may not want to draw strong conclusions from such an analysis,
+it may still be useful for exploration and hypothesis generation."
+
+The argument \code{minReplicatesForReplace} is used to decide which samples
+are eligible for automatic replacement in the case of extreme Cook's distance.
+By default, \code{DESeq} will replace outliers if the Cook's distance is
+large for a sample which has 7 or more replicates (including itself).
+This replacement is performed by the \code{\link{replaceOutliers}}
+function. This default behavior helps to prevent filtering genes
+based on Cook's distance when there are many degrees of freedom.
+See \code{\link{results}} for more information about filtering using
+Cook's distance, and the 'Dealing with outliers' section of the vignette.
+Unlike the behavior of \code{\link{replaceOutliers}}, here original counts are
+kept in the matrix returned by \code{\link{counts}}, original Cook's
+distances are kept in \code{assays(dds)[["cooks"]]}, and the replacement
+counts used for fitting are kept in \code{assays(object)[["replaceCounts"]]}.
+
+Note that if a log2 fold change prior is used (betaPrior=TRUE)
+then expanded model matrices will be used in fitting. These are
+described in \code{\link{nbinomWaldTest}} and in the vignette. The
+\code{contrast} argument of \code{\link{results}} should be used for
+generating results tables.
+}
+\examples{
+
+# see vignette for suggestions on generating
+# count tables from RNA-Seq data
+cnts <- matrix(rnbinom(n=1000, mu=100, size=1/0.5), ncol=10)
+cond <- factor(rep(1:2, each=5))
+
+# object construction
+dds <- DESeqDataSetFromMatrix(cnts, DataFrame(cond), ~ cond)
+
+# standard analysis
+dds <- DESeq(dds)
+res <- results(dds)
+
+# an alternate analysis: likelihood ratio test
+ddsLRT <- DESeq(dds, test="LRT", reduced= ~ 1)
+resLRT <- results(ddsLRT)
+
+}
+\author{
+Michael Love
+}
+\references{
+Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+}
+\seealso{
+\code{\link{nbinomWaldTest}}, \code{\link{nbinomLRT}}
+}
+
diff --git a/man/DESeq2-package.Rd b/man/DESeq2-package.Rd
new file mode 100644
index 0000000..e97c67f
--- /dev/null
+++ b/man/DESeq2-package.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\docType{package}
+\name{DESeq2-package}
+\alias{DESeq2-package}
+\title{DESeq2 package for differential analysis of count data}
+\description{
+The main functions for differential analysis are \code{\link{DESeq}} and
+\code{\link{results}}. See the examples at \code{\link{DESeq}} for basic analysis steps.
+Two transformations offered for count data are
+the "regularized logarithm", \code{\link{rlog}},
+and \code{\link{varianceStabilizingTransformation}}.
+For more detailed information on usage, see the package vignette, by typing
+\code{vignette("DESeq2")}, or the workflow linked to on the first page
+of the vignette. All support questions should be posted to the Bioconductor
+support site: \url{support.bioconductor.org}.
+}
+\author{
+Michael Love, Wolfgang Huber, Simon Anders
+}
+\references{
+DESeq2 reference:
+
+Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+
+DESeq reference:
+
+Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+}
+\keyword{package}
+
diff --git a/man/DESeqDataSet.Rd b/man/DESeqDataSet.Rd
new file mode 100644
index 0000000..a3d92cd
--- /dev/null
+++ b/man/DESeqDataSet.Rd
@@ -0,0 +1,87 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllClasses.R
+\docType{class}
+\name{DESeqDataSet-class}
+\alias{DESeqDataSet}
+\alias{DESeqDataSet-class}
+\alias{DESeqDataSetFromHTSeqCount}
+\alias{DESeqDataSetFromMatrix}
+\title{DESeqDataSet object and constructors}
+\usage{
+DESeqDataSet(se, design, ignoreRank = FALSE)
+
+DESeqDataSetFromMatrix(countData, colData, design, tidy = FALSE,
+ ignoreRank = FALSE, ...)
+
+DESeqDataSetFromHTSeqCount(sampleTable, directory = ".", design,
+ ignoreRank = FALSE, ...)
+}
+\arguments{
+\item{se}{a \code{RangedSummarizedExperiment} with columns of variables
+indicating sample information in \code{colData},
+and the counts as the first element in the assays list, which will
+be renamed "counts". A \code{RangedSummarizedExperiment} object can be
+generated by the function \code{summarizeOverlaps} in the GenomicAlignments
+package.}
+
+\item{design}{a \code{formula} which expresses how the counts for each gene
+depend on the variables in \code{colData}. Many R \code{formula} are valid,
+including designs with multiple variables, e.g., \code{~ group + condition},
+and designs with interactions, e.g., \code{~ genotype + treatment + genotype:treatment}.
+See \code{\link{results}} for a variety of designs and how to extract results tables.
+By default, the functions in this package will use
+the last variable in the formula for building results tables and plotting.
+\code{~ 1} can be used for no design, although users need to remember
+to switch to another design for differential testing.}
+
+\item{ignoreRank}{use of this argument is reserved for DEXSeq developers only.
+Users will immediately encounter an error upon trying to estimate dispersion
+using a design with a model matrix which is not full rank.}
+
+\item{countData}{for matrix input: a matrix of non-negative integers}
+
+\item{colData}{for matrix input: a \code{DataFrame} or \code{data.frame} with at least a single column.
+Rows of colData correspond to columns of countData}
+
+\item{tidy}{for matrix input: whether the first column of countData is the rownames for the count matrix}
+
+\item{...}{arguments provided to \code{SummarizedExperiment} including rowRanges and metadata. Note that
+for Bioconductor 3.1, rowRanges must be a GRanges or GRangesList, with potential metadata columns
+as a DataFrame accessed and stored with \code{mcols}. If a user wants to store metadata columns
+about the rows of the countData, but does not have GRanges or GRangesList information,
+first construct the DESeqDataSet without rowRanges and then add the DataFrame with \code{mcols(dds)}.}
+
+\item{sampleTable}{for htseq-count: a \code{data.frame} with three or more columns. Each row
+describes one sample. The first column is the sample name, the second column
+the file name of the count file generated by htseq-count, and the remaining
+columns are sample metadata which will be stored in \code{colData}}
+
+\item{directory}{for htseq-count: the directory relative to which the filenames are specified. defaults to current directory}
+}
+\value{
+A DESeqDataSet object.
+}
+\description{
+\code{DESeqDataSet} is a subclass of \code{RangedSummarizedExperiment},
+used to store the input values, intermediate calculations and results of an
+analysis of differential expression. The \code{DESeqDataSet} class
+enforces non-negative integer values in the "counts" matrix stored as
+the first element in the assay list.
+In addition, a formula which specifies the design of the experiment must be provided.
+The constructor functions create a DESeqDataSet object
+from various types of input:
+a RangedSummarizedExperiment, a matrix, or count files generated by
+the python package HTSeq. See the vignette for examples of construction
+from all three input types.
+}
+\examples{
+
+countData <- matrix(1:100,ncol=4)
+condition <- factor(c("A","A","B","B"))
+dds <- DESeqDataSetFromMatrix(countData, DataFrame(condition), ~ condition)
+
+}
+\references{
+See \url{http://www-huber.embl.de/users/anders/HTSeq} for htseq-count
+}
+
diff --git a/man/DESeqResults.Rd b/man/DESeqResults.Rd
new file mode 100644
index 0000000..20cfd2b
--- /dev/null
+++ b/man/DESeqResults.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllClasses.R
+\docType{class}
+\name{DESeqResults-class}
+\alias{DESeqResults}
+\alias{DESeqResults-class}
+\title{DESeqResults object and constructor}
+\usage{
+DESeqResults(DataFrame)
+}
+\arguments{
+\item{DataFrame}{a DataFrame of results, standard column names are:
+baseMean, log2FoldChange, lfcSE, stat, pvalue, padj.}
+}
+\value{
+a DESeqResults object
+}
+\description{
+This constructor function would not typically be used by "end users".
+This simple class extends the DataFrame class of the IRanges package
+to allow other packages to write methods for results
+objects from the DESeq2 package. It is used by \code{\link{results}}
+to wrap up the results table.
+}
+
diff --git a/man/DESeqTransform.Rd b/man/DESeqTransform.Rd
new file mode 100644
index 0000000..eaa5cb4
--- /dev/null
+++ b/man/DESeqTransform.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllClasses.R
+\docType{class}
+\name{DESeqTransform-class}
+\alias{DESeqTransform}
+\alias{DESeqTransform-class}
+\title{DESeqTransform object and constructor}
+\usage{
+DESeqTransform(SummarizedExperiment)
+}
+\arguments{
+\item{SummarizedExperiment}{a RangedSummarizedExperiment}
+}
+\value{
+a DESeqTransform object
+}
+\description{
+This constructor function would not typically be used by "end users".
+This simple class extends the RangedSummarizedExperiment class of the
+SummarizedExperiment package.
+It is used by \code{\link{rlog}} and
+\code{\link{varianceStabilizingTransformation}}
+to wrap up the results into a class for downstream methods,
+such as \code{\link{plotPCA}}.
+}
+
diff --git a/man/coef.Rd b/man/coef.Rd
new file mode 100644
index 0000000..bd219c2
--- /dev/null
+++ b/man/coef.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{coef}
+\alias{coef}
+\alias{coef.DESeqDataSet}
+\title{Extract a matrix of model coefficients/standard errors}
+\usage{
+\method{coef}{DESeqDataSet}(object, SE = FALSE, ...)
+}
+\arguments{
+\item{object}{a DESeqDataSet returned by \code{\link{DESeq}}, \code{\link{nbinomWaldTest}},
+or \code{\link{nbinomLRT}}.}
+
+\item{SE}{whether to give the standard errors instead of coefficients.
+defaults to FALSE so that the coefficients are given.}
+
+\item{...}{additional arguments}
+}
+\description{
+\strong{Note:} results tables with log2 fold change, p-values, adjusted p-values, etc.
+for each gene are best generated using the \code{\link{results}} function. The \code{coef}
+function is designed for advanced users who wish to inspect all model coefficients at once.
+}
+\details{
+Estimated model coefficients or estimated standard errors are provided in a matrix
+form, number of genes by number of parameters, on the log2 scale.
+The columns correspond to columns of the model matrix for final GLM fitting, i.e.,
+\code{attr(dds, "modelMatrix")}.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=4)
+dds <- DESeq(dds)
+coef(dds)[1,]
+coef(dds, SE=TRUE)[1,]
+
+}
+\author{
+Michael Love
+}
+
diff --git a/man/collapseReplicates.Rd b/man/collapseReplicates.Rd
new file mode 100644
index 0000000..dc3435c
--- /dev/null
+++ b/man/collapseReplicates.Rd
@@ -0,0 +1,57 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\name{collapseReplicates}
+\alias{collapseReplicates}
+\title{Collapse technical replicates in a RangedSummarizedExperiment or DESeqDataSet}
+\usage{
+collapseReplicates(object, groupby, run, renameCols = TRUE)
+}
+\arguments{
+\item{object}{A \code{RangedSummarizedExperiment} or \code{DESeqDataSet}}
+
+\item{groupby}{a grouping factor, as long as the columns of object}
+
+\item{run}{optional, the names of each unique column in object. if provided,
+a new column \code{runsCollapsed} will be added to the \code{colData}
+which pastes together the names of \code{run}}
+
+\item{renameCols}{whether to rename the columns of the returned object
+using the levels of the grouping factor}
+}
+\value{
+the \code{object} with as many columns as levels in \code{groupby}.
+This object has assay/count data which is summed from the various
+columns which are grouped together, and the \code{colData} is subset using
+the first column for each group in \code{groupby}.
+}
+\description{
+Collapses the columns in \code{object} by summing within levels
+of a grouping factor \code{groupby}. The purpose of this function
+is to sum up read counts from technical replicates to create an object
+with a single column of read counts for each sample.
+Optionally renames the columns of returned object with the levels of the
+grouping factor.
+Note: this function is written very simply and
+can be easily altered to produce other behavior by examining the source code.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=12)
+
+# make data with two technical replicates for three samples
+dds$sample <- factor(sample(paste0("sample",rep(1:9, c(2,1,1,2,1,1,2,1,1)))))
+dds$run <- paste0("run",1:12)
+
+ddsColl <- collapseReplicates(dds, dds$sample, dds$run)
+
+# examine the colData and column names of the collapsed data
+colData(ddsColl)
+colnames(ddsColl)
+
+# check that the sum of the counts for "sample1" is the same
+# as the counts in the "sample1" column in ddsColl
+matchFirstLevel <- dds$sample == levels(dds$sample)[1]
+stopifnot(all(rowSums(counts(dds[,matchFirstLevel])) == counts(ddsColl[,1])))
+
+}
+
diff --git a/man/counts.Rd b/man/counts.Rd
new file mode 100644
index 0000000..61055fe
--- /dev/null
+++ b/man/counts.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{counts}
+\alias{counts}
+\alias{counts,DESeqDataSet-method}
+\alias{counts<-,DESeqDataSet,matrix-method}
+\title{Accessors for the 'counts' slot of a DESeqDataSet object.}
+\usage{
+\S4method{counts}{DESeqDataSet}(object, normalized = FALSE,
+ replaced = FALSE)
+
+\S4method{counts}{DESeqDataSet,matrix}(object) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object.}
+
+\item{normalized}{logical indicating whether or not to divide the counts by
+the size factors or normalization factors before returning
+(normalization factors always preempt size factors)}
+
+\item{replaced}{after a \code{DESeq} call, this argument will return the counts
+with outliers replaced instead of the original counts, and optionally \code{normalized}.
+The replaced counts are stored by \code{DESeq} in \code{assays(object)[['replaceCounts']]}.}
+
+\item{value}{an integer matrix}
+}
+\description{
+The counts slot holds the count data as a matrix of non-negative integer
+count values, one row for each observational unit (gene or the like), and one
+column for each sample.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=4)
+head(counts(dds))
+
+dds <- estimateSizeFactors(dds) # run this or DESeq() first
+head(counts(dds, normalized=TRUE))
+
+}
+\author{
+Simon Anders
+}
+\seealso{
+\code{\link{sizeFactors}}, \code{\link{normalizationFactors}}
+}
+
diff --git a/man/design.Rd b/man/design.Rd
new file mode 100644
index 0000000..dd7c02a
--- /dev/null
+++ b/man/design.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{design}
+\alias{design}
+\alias{design,DESeqDataSet-method}
+\alias{design<-,DESeqDataSet,formula-method}
+\title{Accessors for the 'design' slot of a DESeqDataSet object.}
+\usage{
+\S4method{design}{DESeqDataSet}(object)
+
+\S4method{design}{DESeqDataSet,formula}(object) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object}
+
+\item{value}{a \code{formula} used for estimating dispersion
+and fitting Negative Binomial GLMs}
+}
+\description{
+The design holds the R \code{formula} which expresses how the
+counts depend on the variables in \code{colData}.
+See \code{\link{DESeqDataSet}} for details.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=4)
+design(dds) <- formula(~ 1)
+
+}
+
diff --git a/man/dispersionFunction.Rd b/man/dispersionFunction.Rd
new file mode 100644
index 0000000..119d0f9
--- /dev/null
+++ b/man/dispersionFunction.Rd
@@ -0,0 +1,51 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllGenerics.R, R/methods.R
+\docType{methods}
+\name{dispersionFunction}
+\alias{dispersionFunction}
+\alias{dispersionFunction,DESeqDataSet-method}
+\alias{dispersionFunction<-}
+\alias{dispersionFunction<-,DESeqDataSet,function-method}
+\title{Accessors for the 'dispersionFunction' slot of a DESeqDataSet object.}
+\usage{
+dispersionFunction(object, ...)
+
+dispersionFunction(object, ...) <- value
+
+\S4method{dispersionFunction}{DESeqDataSet}(object)
+
+\S4method{dispersionFunction}{DESeqDataSet,`function`}(object,
+ estimateVar = TRUE) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object.}
+
+\item{...}{additional arguments}
+
+\item{value}{a \code{function}}
+
+\item{estimateVar}{whether to estimate the variance of dispersion residuals.
+setting to FALSE is needed, e.g. within \code{estimateDispersionsMAP} when
+called on a subset of the full dataset in parallel execution.}
+}
+\description{
+The dispersion function is calculated by \code{\link{estimateDispersions}} and
+used by \code{\link{varianceStabilizingTransformation}}. Parametric dispersion
+fits store the coefficients of the fit as attributes in this slot.
+}
+\details{
+Setting this will also overwrite \code{mcols(object)$dispFit} and the estimate
+the variance of dispersion residuals, see \code{estimateVar} below.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=4)
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+dispersionFunction(dds)
+
+}
+\seealso{
+\code{\link{estimateDispersions}}
+}
+
diff --git a/man/dispersions.Rd b/man/dispersions.Rd
new file mode 100644
index 0000000..849c942
--- /dev/null
+++ b/man/dispersions.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllGenerics.R, R/methods.R
+\docType{methods}
+\name{dispersions}
+\alias{dispersions}
+\alias{dispersions,DESeqDataSet-method}
+\alias{dispersions<-}
+\alias{dispersions<-,DESeqDataSet,numeric-method}
+\title{Accessor functions for the dispersion estimates in a DESeqDataSet
+object.}
+\usage{
+dispersions(object, ...)
+
+dispersions(object, ...) <- value
+
+\S4method{dispersions}{DESeqDataSet}(object)
+
+\S4method{dispersions}{DESeqDataSet,numeric}(object) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object.}
+
+\item{...}{additional arguments}
+
+\item{value}{the dispersions to use for the Negative Binomial modeling}
+}
+\description{
+The dispersions for each row of the DESeqDataSet. Generally,
+these are set by \code{\link{estimateDispersions}}.
+}
+\author{
+Simon Anders
+}
+\seealso{
+\code{\link{estimateDispersions}}
+}
+
diff --git a/man/estimateBetaPriorVar.Rd b/man/estimateBetaPriorVar.Rd
new file mode 100644
index 0000000..95d058d
--- /dev/null
+++ b/man/estimateBetaPriorVar.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{estimateBetaPriorVar}
+\alias{estimateBetaPriorVar}
+\alias{estimateMLEForBetaPriorVar}
+\title{Steps for estimating the beta prior variance}
+\usage{
+estimateBetaPriorVar(object, betaPriorMethod = c("weighted", "quantile"),
+ upperQuantile = 0.05)
+
+estimateMLEForBetaPriorVar(object, maxit = 100, useOptim = TRUE,
+ useQR = TRUE)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{betaPriorMethod}{the method for calculating the beta prior variance,
+either "quanitle" or "weighted":
+"quantile" matches a normal distribution using the upper quantile of the finite MLE betas.
+"weighted" matches a normal distribution using the upper quantile, but weighting by the variance of the MLE betas.}
+
+\item{upperQuantile}{the upper quantile to be used for the
+"quantile" or "weighted" method of beta prior variance estimation}
+
+\item{maxit}{as defined in \code{link{nbinomWaldTest}}}
+
+\item{useOptim}{as defined in \code{link{nbinomWaldTest}}}
+
+\item{useQR}{as defined in \code{link{nbinomWaldTest}}}
+}
+\value{
+for \code{estimateMLEForBetaPriorVar}, a DESeqDataSet, with the
+necessary information stored in order to calculate the prior variance.
+for \code{estimateBetaPriorVar}, the vector of variances for the prior
+on the betas in the \code{\link{DESeq}} GLM
+}
+\description{
+These lower-level functions are called within \code{\link{DESeq}} or \code{\link{nbinomWaldTest}}.
+End users should use those higher-level function instead.
+NOTE: \code{estimateBetaPriorVar} returns a numeric vector, not a DESEqDataSet!
+For advanced users: to use these functions, first run \code{estimateMLEForBetaPriorVar}
+and then run \code{estimateBetaPriorVar}.
+}
+
diff --git a/man/estimateDispersions.Rd b/man/estimateDispersions.Rd
new file mode 100644
index 0000000..fab24d2
--- /dev/null
+++ b/man/estimateDispersions.Rd
@@ -0,0 +1,103 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{estimateDispersions}
+\alias{estimateDispersions}
+\alias{estimateDispersions,DESeqDataSet-method}
+\title{Estimate the dispersions for a DESeqDataSet}
+\usage{
+\S4method{estimateDispersions}{DESeqDataSet}(object, fitType = c("parametric",
+ "local", "mean"), maxit = 100, quiet = FALSE, modelMatrix = NULL)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{fitType}{either "parametric", "local", or "mean"
+for the type of fitting of dispersions to the mean intensity.
+\itemize{
+ \item parametric - fit a dispersion-mean relation of the form:
+ \deqn{dispersion = asymptDisp + extraPois / mean}
+ via a robust gamma-family GLM. The coefficients \code{asymptDisp} and \code{extraPois}
+ are given in the attribute \code{coefficients} of the \code{\link{dispersionFunction}}
+ of the object.
+ \item local - use the locfit package to fit a local regression
+ of log dispersions over log base mean (normal scale means and dispersions
+ are input and output for \code{\link{dispersionFunction}}). The points
+ are weighted by normalized mean count in the local regression.
+ \item mean - use the mean of gene-wise dispersion estimates.
+}}
+
+\item{maxit}{control parameter: maximum number of iterations to allow for convergence}
+
+\item{quiet}{whether to print messages at each step}
+
+\item{modelMatrix}{an optional matrix which will be used for fitting the expected counts.
+by default, the model matrix is constructed from \code{design(object)}}
+}
+\value{
+The DESeqDataSet passed as parameters, with the dispersion information
+filled in as metadata columns, accessible via \code{mcols}, or the final dispersions
+accessible via \code{\link{dispersions}}.
+}
+\description{
+This function obtains dispersion estimates for Negative Binomial distributed data.
+}
+\details{
+Typically the function is called with the idiom:
+
+\code{dds <- estimateDispersions(dds)}
+
+The fitting proceeds as follows: for each gene, an estimate of the dispersion
+is found which maximizes the Cox Reid-adjusted profile likelihood
+(the methods of Cox Reid-adjusted profile likelihood maximization for
+estimation of dispersion in RNA-Seq data were developed by McCarthy,
+et al. (2012), first implemented in the edgeR package in 2010);
+a trend line capturing the dispersion-mean relationship is fit to the maximum likelihood estimates;
+a normal prior is determined for the log dispersion estimates centered
+on the predicted value from the trended fit
+with variance equal to the difference between the observed variance of the
+log dispersion estimates and the expected sampling variance;
+finally maximum a posteriori dispersion estimates are returned.
+This final dispersion parameter is used in subsequent tests.
+The final dispersion estimates can be accessed from an object using \code{\link{dispersions}}.
+The fitted dispersion-mean relationship is also used in
+\code{\link{varianceStabilizingTransformation}}.
+All of the intermediate values (gene-wise dispersion estimates, fitted dispersion
+estimates from the trended fit, etc.) are stored in \code{mcols(dds)}, with
+information about these columns in \code{mcols(mcols(dds))}.
+
+The log normal prior on the dispersion parameter has been proposed
+by Wu, et al. (2012) and is also implemented in the DSS package.
+
+In DESeq2, the dispersion estimation procedure described above replaces the
+different methods of dispersion from the previous version of the DESeq package.
+
+\code{estimateDispersions} checks for the case of an analysis
+with as many samples as the number of coefficients to fit,
+and will temporarily substitute a design formula \code{~ 1} for the
+purposes of dispersion estimation. This treats the samples as
+replicates for the purpose of dispersion estimation. As mentioned in the DESeq paper:
+"While one may not want to draw strong conclusions from such an analysis,
+it may still be useful for exploration and hypothesis generation."
+
+The lower-level functions called by \code{estimateDispersions} are:
+\code{\link{estimateDispersionsGeneEst}},
+\code{\link{estimateDispersionsFit}}, and
+\code{\link{estimateDispersionsMAP}}.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+head(dispersions(dds))
+
+}
+\references{
+\itemize{
+ \item Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 11 (2010) R106, \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+ \item McCarthy, DJ, Chen, Y, Smyth, GK: Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation. Nucleic Acids Research 40 (2012), 4288-4297, \url{http://dx.doi.org/10.1093/nar/gks042}
+ \item Wu, H., Wang, C. & Wu, Z. A new shrinkage estimator for dispersion improves differential expression detection in RNA-seq data. Biostatistics (2012). \url{http://dx.doi.org/10.1093/biostatistics/kxs033}
+}
+}
+
diff --git a/man/estimateDispersionsGeneEst.Rd b/man/estimateDispersionsGeneEst.Rd
new file mode 100644
index 0000000..b025667
--- /dev/null
+++ b/man/estimateDispersionsGeneEst.Rd
@@ -0,0 +1,98 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{estimateDispersionsGeneEst}
+\alias{estimateDispersionsFit}
+\alias{estimateDispersionsGeneEst}
+\alias{estimateDispersionsMAP}
+\alias{estimateDispersionsPriorVar}
+\title{Low-level functions to fit dispersion estimates}
+\usage{
+estimateDispersionsGeneEst(object, minDisp = 1e-08, kappa_0 = 1,
+ dispTol = 1e-06, maxit = 100, quiet = FALSE, modelMatrix = NULL,
+ niter = 1)
+
+estimateDispersionsFit(object, fitType = c("parametric", "local", "mean"),
+ minDisp = 1e-08, quiet = FALSE)
+
+estimateDispersionsMAP(object, outlierSD = 2, dispPriorVar, minDisp = 1e-08,
+ kappa_0 = 1, dispTol = 1e-06, maxit = 100, modelMatrix = NULL,
+ quiet = FALSE)
+
+estimateDispersionsPriorVar(object, minDisp = 1e-08, modelMatrix = NULL)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{minDisp}{small value for the minimum dispersion, to allow
+for calculations in log scale, one order of magnitude above this value is used
+as a test for inclusion in mean-dispersion fitting}
+
+\item{kappa_0}{control parameter used in setting the initial proposal
+in backtracking search, higher kappa_0 results in larger steps}
+
+\item{dispTol}{control parameter to test for convergence of log dispersion,
+stop when increase in log posterior is less than dispTol}
+
+\item{maxit}{control parameter: maximum number of iterations to allow for convergence}
+
+\item{quiet}{whether to print messages at each step}
+
+\item{modelMatrix}{for advanced use only,
+a substitute model matrix for gene-wise and MAP dispersion estimation}
+
+\item{niter}{number of times to iterate between estimation of means and
+estimation of dispersion}
+
+\item{fitType}{either "parametric", "local", or "mean"
+for the type of fitting of dispersions to the mean intensity.
+See \code{\link{estimateDispersions}} for description.}
+
+\item{outlierSD}{the number of standard deviations of log
+gene-wise estimates above the prior mean (fitted value),
+above which dispersion estimates will be labelled
+outliers. Outliers will keep their original value and
+not be shrunk using the prior.}
+
+\item{dispPriorVar}{the variance of the normal prior on the log dispersions.
+If not supplied, this is calculated as the difference between
+the mean squared residuals of gene-wise estimates to the
+fitted dispersion and the expected sampling variance
+of the log dispersion}
+}
+\value{
+a DESeqDataSet with gene-wise, fitted, or final MAP
+dispersion estimates in the metadata columns of the object.
+
+\code{estimateDispersionsPriorVar} is called inside of \code{estimateDispersionsMAP}
+and stores the dispersion prior variance as an attribute of
+\code{dispersionFunction(dds)}, which can be manually provided to
+\code{estimateDispersionsMAP} for parallel execution.
+}
+\description{
+Normal users should instead use \code{\link{estimateDispersions}}.
+These low-level functions are called by \code{\link{estimateDispersions}},
+but are exported and documented for non-standard usage.
+For instance, it is possible to replace fitted values with a custom fit and continue
+with the maximum a posteriori dispersion estimation, as demonstrated in the
+examples below.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersionsGeneEst(dds)
+dds <- estimateDispersionsFit(dds)
+dds <- estimateDispersionsMAP(dds)
+plotDispEsts(dds)
+
+# after having run estimateDispersionsFit()
+# the dispersion prior variance over all genes
+# can be obtained like so:
+
+dispPriorVar <- estimateDispersionsPriorVar(dds)
+
+}
+\seealso{
+\code{\link{estimateDispersions}}
+}
+
diff --git a/man/estimateSizeFactors.Rd b/man/estimateSizeFactors.Rd
new file mode 100644
index 0000000..24f1074
--- /dev/null
+++ b/man/estimateSizeFactors.Rd
@@ -0,0 +1,96 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{estimateSizeFactors}
+\alias{estimateSizeFactors}
+\alias{estimateSizeFactors,DESeqDataSet-method}
+\title{Estimate the size factors for a DESeqDataSet}
+\usage{
+\S4method{estimateSizeFactors}{DESeqDataSet}(object, type = c("ratio",
+ "iterate"), locfunc = stats::median, geoMeans, controlGenes, normMatrix)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{type}{either "ratio" or "iterate". "ratio" uses the standard
+median ratio method introduced in DESeq. The size factor is the
+median ratio of the sample over a pseudosample: for each gene, the geometric mean
+of all samples. "iterate" offers an alternative estimator, which can be
+used even when all genes contain a sample with a zero. This estimator
+iterates between estimating the dispersion with a design of ~1, and
+finding a size factor vector by numerically optimizing the likelihood
+of the ~1 model.}
+
+\item{locfunc}{a function to compute a location for a sample. By default, the
+median is used. However, especially for low counts, the
+\code{\link[genefilter]{shorth}} function from the genefilter package may give better results.}
+
+\item{geoMeans}{by default this is not provided and the
+geometric means of the counts are calculated within the function.
+A vector of geometric means from another count matrix can be provided
+for a "frozen" size factor calculation}
+
+\item{controlGenes}{optional, numeric or logical index vector specifying those genes to
+use for size factor estimation (e.g. housekeeping or spike-in genes)}
+
+\item{normMatrix}{optional, a matrix of normalization factors which do not
+control for library size (e.g. average transcript length of genes for each
+sample). Providing \code{normMatrix} will estimate size factors on the
+count matrix divided by \code{normMatrix} and store the product of the
+size factors and \code{normMatrix} as \code{\link{normalizationFactors}}.}
+}
+\value{
+The DESeqDataSet passed as parameters, with the size factors filled
+in.
+}
+\description{
+This function estimates the size factors using the
+"median ratio method" described by Equation 5 in Anders and Huber (2010).
+The estimated size factors can be accessed using \code{\link{sizeFactors}}.
+Alternative library size estimators can also be supplied
+using \code{\link{sizeFactors}}.
+}
+\details{
+Typically, the function is called with the idiom:
+
+\code{dds <- estimateSizeFactors(dds)}
+
+See \code{\link{DESeq}} for a description of the use of size factors in the GLM.
+One should call this function after \code{\link{DESeqDataSet}}
+unless size factors are manually specified with \code{\link{sizeFactors}}.
+Alternatively, gene-specific normalization factors for each sample can be provided using
+\code{\link{normalizationFactors}} which will always preempt \code{\link{sizeFactors}}
+in calculations.
+
+Internally, the function calls \code{\link{estimateSizeFactorsForMatrix}},
+which provides more details on the calculation.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(n=1000, m=4)
+dds <- estimateSizeFactors(dds)
+sizeFactors(dds)
+
+dds <- estimateSizeFactors(dds, controlGenes=1:200)
+
+m <- matrix(runif(1000 * 4, .5, 1.5), ncol=4)
+dds <- estimateSizeFactors(dds, normMatrix=m)
+normalizationFactors(dds)[1:3,]
+
+geoMeans <- exp(rowMeans(log(counts(dds))))
+dds <- estimateSizeFactors(dds,geoMeans=geoMeans)
+sizeFactors(dds)
+
+}
+\author{
+Simon Anders
+}
+\references{
+Reference for the median ratio method:
+
+Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+}
+\seealso{
+\code{\link{estimateSizeFactorsForMatrix}}
+}
+
diff --git a/man/estimateSizeFactorsForMatrix.Rd b/man/estimateSizeFactorsForMatrix.Rd
new file mode 100644
index 0000000..14121e1
--- /dev/null
+++ b/man/estimateSizeFactorsForMatrix.Rd
@@ -0,0 +1,51 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{estimateSizeFactorsForMatrix}
+\alias{estimateSizeFactorsForMatrix}
+\title{Low-level function to estimate size factors with robust regression.}
+\usage{
+estimateSizeFactorsForMatrix(counts, locfunc = stats::median, geoMeans,
+ controlGenes)
+}
+\arguments{
+\item{counts}{a matrix or data frame of counts, i.e., non-negative integer
+values}
+
+\item{locfunc}{a function to compute a location for a sample. By default, the
+median is used. However, especially for low counts, the
+\code{\link[genefilter]{shorth}} function from genefilter may give better results.}
+
+\item{geoMeans}{by default this is not provided, and the
+geometric means of the counts are calculated within the function.
+A vector of geometric means from another count matrix can be provided
+for a "frozen" size factor calculation}
+
+\item{controlGenes}{optional, numeric or logical index vector specifying those genes to
+use for size factor estimation (e.g. housekeeping or spike-in genes)}
+}
+\value{
+a vector with the estimates size factors, one element per column
+}
+\description{
+Given a matrix or data frame of count data, this function estimates the size
+factors as follows: Each column is divided by the geometric means of the
+rows. The median (or, if requested, another location estimator) of these
+ratios (skipping the genes with a geometric mean of zero) is used as the size
+factor for this column. Typically, one will not call this function directly, but use
+\code{\link{estimateSizeFactors}}.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+estimateSizeFactorsForMatrix(counts(dds))
+geoMeans <- exp(rowMeans(log(counts(dds))))
+estimateSizeFactorsForMatrix(counts(dds),geoMeans=geoMeans)
+
+}
+\author{
+Simon Anders
+}
+\seealso{
+\code{\link{estimateSizeFactors}}
+}
+
diff --git a/man/fpkm.Rd b/man/fpkm.Rd
new file mode 100644
index 0000000..455b9af
--- /dev/null
+++ b/man/fpkm.Rd
@@ -0,0 +1,78 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\docType{methods}
+\name{fpkm}
+\alias{fpkm}
+\title{FPKM: fragments per kilobase per million mapped fragments}
+\usage{
+fpkm(object, robust = TRUE)
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet}}
+
+\item{robust}{whether to use size factors to normalize
+rather than taking the column sums of the raw counts,
+using the \code{\link{fpm}} function.}
+}
+\value{
+a matrix which is normalized per kilobase of the
+union of basepairs in the \code{GRangesList} or \code{GRanges}
+of the mcols(object), and per million of mapped fragments,
+either using the robust median ratio method (robust=TRUE, default)
+or using raw counts (robust=FALSE).
+Defining a column \code{mcols(object)$basepairs} takes
+precedence over internal calculation of the kilobases for each row.
+}
+\description{
+The following function returns fragment counts normalized
+per kilobase of feature length per million mapped fragments
+(by default using a robust estimate of the library size,
+as in \code{\link{estimateSizeFactors}}).
+}
+\details{
+The length of the features (e.g. genes) is calculated one of two ways:
+if there is a matrix named "avgTxLength" in \code{assays(dds)}, this will take precedence in the
+length normalization. Otherwise, feature length is calculated
+from the \code{rowRanges} of the dds object,
+if a column \code{basepairs} is not present in \code{mcols(dds)}.
+The calculated length is the number of basepairs in the union of all \code{GRanges}
+assigned to a given row of \code{object}, e.g.,
+the union of all basepairs of exons of a given gene.
+
+Note that, when the read/fragment counting has inter-feature dependencies, a strict
+normalization would not incorporate the basepairs of a feature which
+overlap another feature. This inter-feature dependence is not taken into
+consideration in the internal union basepair calculation.
+}
+\examples{
+
+# create a matrix with 1 million counts for the
+# 2nd and 3rd column, the 1st and 4th have
+# half and double the counts, respectively.
+m <- matrix(1e6 * rep(c(.125, .25, .25, .5), each=4),
+ ncol=4, dimnames=list(1:4,1:4))
+mode(m) <- "integer"
+se <- SummarizedExperiment(list(counts=m), colData=DataFrame(sample=1:4))
+dds <- DESeqDataSet(se, ~ 1)
+
+# create 4 GRanges with lengths: 1, 1, 2, 2.5 Kb
+gr1 <- GRanges("chr1",IRanges(1,1000)) # 1kb
+gr2 <- GRanges("chr1",IRanges(c(1,1001),c( 500,1500))) # 1kb
+gr3 <- GRanges("chr1",IRanges(c(1,1001),c(1000,2000))) # 2kb
+gr4 <- GRanges("chr1",IRanges(c(1,1001),c(200,1300))) # 500bp
+rowRanges(dds) <- GRangesList(gr1,gr2,gr3,gr4)
+
+# the raw counts
+counts(dds)
+
+# the FPM values
+fpm(dds)
+
+# the FPKM values
+fpkm(dds)
+
+}
+\seealso{
+\code{\link{fpm}}
+}
+
diff --git a/man/fpm.Rd b/man/fpm.Rd
new file mode 100644
index 0000000..00d618a
--- /dev/null
+++ b/man/fpm.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\docType{methods}
+\name{fpm}
+\alias{fpm}
+\title{FPM: fragments per million mapped fragments}
+\usage{
+fpm(object, robust = TRUE)
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet}}
+
+\item{robust}{whether to use size factors to normalize
+rather than taking the column sums of the raw counts.
+If TRUE, the size factors and the geometric mean of
+column sums are multiplied to create a robust library size estimate.}
+}
+\value{
+a matrix which is normalized per million of mapped fragments,
+either using the robust median ratio method (robust=TRUE, default)
+or using raw counts (robust=FALSE).
+}
+\description{
+Calculates either a robust version (default)
+or the traditional matrix of fragments/counts per million mapped
+fragments (FPM/CPM).
+Note: this function is written very simply and
+can be easily altered to produce other behavior by examining the source code.
+}
+\examples{
+
+# generate a dataset with size factors: .5, 1, 1, 2
+dds <- makeExampleDESeqDataSet(m = 4, n = 1000,
+ interceptMean=log2(1e3),
+ interceptSD=0,
+ sizeFactors=c(.5,1,1,2),
+ dispMeanRel=function(x) .01)
+
+# add a few rows with very high count
+counts(dds)[4:10,] <- 2e5L
+
+# in this robust version, the counts are comparable across samples
+round(head(fpm(dds), 3))
+
+# in this column sum version, the counts are still skewed:
+# sample1 < sample2 & 3 < sample 4
+round(head(fpm(dds, robust=FALSE), 3))
+
+# the column sums of the robust version
+# are not equal to 1e6, but the
+# column sums of the non-robust version
+# are equal to 1e6 by definition
+
+colSums(fpm(dds))/1e6
+colSums(fpm(dds, robust=FALSE))/1e6
+
+}
+\seealso{
+\code{\link{fpkm}}
+}
+
diff --git a/man/makeExampleDESeqDataSet.Rd b/man/makeExampleDESeqDataSet.Rd
new file mode 100644
index 0000000..1b8c1d5
--- /dev/null
+++ b/man/makeExampleDESeqDataSet.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{makeExampleDESeqDataSet}
+\alias{makeExampleDESeqDataSet}
+\title{Make a simulated DESeqDataSet}
+\usage{
+makeExampleDESeqDataSet(n = 1000, m = 12, betaSD = 0, interceptMean = 4,
+ interceptSD = 2, dispMeanRel = function(x) 4/x + 0.1,
+ sizeFactors = rep(1, m))
+}
+\arguments{
+\item{n}{number of rows}
+
+\item{m}{number of columns}
+
+\item{betaSD}{the standard deviation for non-intercept betas, i.e. beta ~ N(0,betaSD)}
+
+\item{interceptMean}{the mean of the intercept betas (log2 scale)}
+
+\item{interceptSD}{the standard deviation of the intercept betas (log2 scale)}
+
+\item{dispMeanRel}{a function specifying the relationship of the dispersions on
+\code{2^trueIntercept}}
+
+\item{sizeFactors}{multiplicative factors for each sample}
+}
+\value{
+a \code{\link{DESeqDataSet}} with true dispersion,
+intercept and beta values in the metadata columns. Note that the true
+betas are provided on the log2 scale.
+}
+\description{
+Constructs a simulated dataset of Negative Binomial data from
+two conditions. By default, there are no fold changes between
+the two conditions, but this can be adjusted with the \code{betaSD} argument.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds
+
+}
+
diff --git a/man/nbinomLRT.Rd b/man/nbinomLRT.Rd
new file mode 100644
index 0000000..5124633
--- /dev/null
+++ b/man/nbinomLRT.Rd
@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{nbinomLRT}
+\alias{nbinomLRT}
+\title{Likelihood ratio test (chi-squared test) for GLMs}
+\usage{
+nbinomLRT(object, full = design(object), reduced, betaPrior = FALSE,
+ betaPriorVar, maxit = 100, useOptim = TRUE, quiet = FALSE,
+ useQR = TRUE)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{full}{the full model formula, this should be the formula in
+\code{design(object)}.
+alternatively, can be a matrix}
+
+\item{reduced}{a reduced formula to compare against, e.g.
+the full model with a term or terms of interest removed.
+alternatively, can be a matrix}
+
+\item{betaPrior}{whether or not to put a zero-mean normal prior on
+the non-intercept coefficients
+While the beta prior is used typically, for the Wald test, it can
+also be specified for the likelihood ratio test. For more details
+on the calculation, see \code{\link{nbinomWaldTest}}.}
+
+\item{betaPriorVar}{a vector with length equal to the number of
+model terms including the intercept.
+which if missing is estimated from the rows which do not have any
+zeros}
+
+\item{maxit}{the maximum number of iterations to allow for convergence of the
+coefficient vector}
+
+\item{useOptim}{whether to use the native optim function on rows which do not
+converge within maxit}
+
+\item{quiet}{whether to print messages at each step}
+
+\item{useQR}{whether to use the QR decomposition on the design
+matrix X while fitting the GLM}
+}
+\value{
+a DESeqDataSet with new results columns accessible
+with the \code{\link{results}} function. The coefficients and standard errors are
+reported on a log2 scale.
+}
+\description{
+This function tests for significance of change in deviance between a
+full and reduced model which are provided as \code{formula}.
+Fitting uses previously calculated \code{\link{sizeFactors}} (or \code{\link{normalizationFactors}})
+and dispersion estimates.
+}
+\details{
+The difference in deviance is compared to a chi-squared distribution
+with df = (reduced residual degrees of freedom - full residual degrees of freedom).
+This function is comparable to the \code{nbinomGLMTest} of the previous version of DESeq
+and an alternative to the default \code{\link{nbinomWaldTest}}.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+dds <- nbinomLRT(dds, reduced = ~ 1)
+res <- results(dds)
+
+}
+\seealso{
+\code{\link{DESeq}}, \code{\link{nbinomWaldTest}}
+}
+
diff --git a/man/nbinomWaldTest.Rd b/man/nbinomWaldTest.Rd
new file mode 100644
index 0000000..bec8aaa
--- /dev/null
+++ b/man/nbinomWaldTest.Rd
@@ -0,0 +1,122 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{nbinomWaldTest}
+\alias{nbinomWaldTest}
+\title{Wald test for the GLM coefficients}
+\usage{
+nbinomWaldTest(object, betaPrior, betaPriorVar, modelMatrix = NULL,
+ modelMatrixType, maxit = 100, useOptim = TRUE, quiet = FALSE,
+ useT = FALSE, df, useQR = TRUE)
+}
+\arguments{
+\item{object}{a DESeqDataSet}
+
+\item{betaPrior}{whether or not to put a zero-mean normal prior on
+the non-intercept coefficients}
+
+\item{betaPriorVar}{a vector with length equal to the number of
+model terms including the intercept.
+betaPriorVar gives the variance of the prior on the sample betas
+on the log2 scale. if missing (default) this is estimated from the data}
+
+\item{modelMatrix}{an optional matrix, typically this is set to NULL
+and created within the function. only can be supplied if betaPrior=FALSE}
+
+\item{modelMatrixType}{either "standard" or "expanded", which describe
+how the model matrix, X of the formula in \code{\link{DESeq}}, is
+formed. "standard" is as created by \code{model.matrix} using the
+design formula. "expanded" includes an indicator variable for each
+level of factors in addition to an intercept.
+betaPrior must be set to TRUE in order for expanded model matrices
+to be fit.}
+
+\item{maxit}{the maximum number of iterations to allow for convergence of the
+coefficient vector}
+
+\item{useOptim}{whether to use the native optim function on rows which do not
+converge within maxit}
+
+\item{quiet}{whether to print messages at each step}
+
+\item{useT}{whether to use a t-distribution as a null distribution,
+for significance testing of the Wald statistics.
+If FALSE, a standard normal null distribution is used.}
+
+\item{df}{the degrees of freedom for the t-distribution}
+
+\item{useQR}{whether to use the QR decomposition on the design
+matrix X while fitting the GLM}
+}
+\value{
+a DESeqDataSet with results columns accessible
+with the \code{\link{results}} function. The coefficients and standard errors are
+reported on a log2 scale.
+}
+\description{
+This function tests for significance of coefficients in a Negative
+Binomial GLM, using previously calculated \code{\link{sizeFactors}}
+(or \code{\link{normalizationFactors}})
+and dispersion estimates. See \code{\link{DESeq}} for the GLM formula.
+}
+\details{
+The fitting proceeds as follows: standard maximum likelihood estimates
+for GLM coefficients (synonymous with "beta", "log2 fold change", "effect size")
+are calculated. A zero-centered Normal prior distribution
+is assumed for the coefficients other than the intercept.
+The variance of the prior distribution for each
+non-intercept coefficient is calculated using the observed
+distribution of the maximum likelihood coefficients.
+The final coefficients are then maximum a posteriori estimates
+using this prior (Tikhonov/ridge regularization). See below for details on the
+prior variance and the Methods section of the DESeq2 manuscript for more detail.
+The use of a prior has little effect on genes with high counts and helps to
+moderate the large spread in coefficients for genes with low counts.
+For calculating Wald test p-values, the coefficients are scaled by their
+standard errors and then compared to a standard Normal distribution.
+
+The prior variance is calculated by matching the 0.05 upper quantile
+of the observed MLE coefficients to a zero-centered Normal distribution.
+In a change of methods since the 2014 paper,
+the weighted upper quantile is calculated using the
+\code{wtd.quantile} function from the Hmisc package. The weights are
+the inverse of the expected variance of log counts, so the inverse of
+\eqn{1/\bar{\mu} + \alpha_{tr}}{1/mu-bar + alpha_tr} using the mean of
+normalized counts and the trended dispersion fit. The weighting ensures
+that noisy estimates of log fold changes from small count genes do not
+overly influence the calculation of the prior variance.
+The final prior variance for a factor level is the average of the
+estimated prior variance over all contrasts of all levels of the factor.
+Another change since the 2014 paper: when interaction terms are present
+in the design, the prior on log fold changes is turned off
+(for more details, see the vignette section, "Methods changes since
+the 2014 DESeq2 paper").
+
+When a log2 fold change prior is used (betaPrior=TRUE),
+then \code{nbinomWaldTest} will by default use expanded model matrices,
+as described in the \code{modelMatrixType} argument, unless this argument
+is used to override the default behavior.
+This ensures that log2 fold changes will be independent of the choice
+of reference level. In this case, the beta prior variance for each factor
+is calculated as the average of the mean squared maximum likelihood
+estimates for each level and every possible contrast. The \code{\link{results}}
+function without any arguments will automatically perform a contrast of the
+last level of the last variable in the design formula over the first level.
+The \code{contrast} argument of the \code{\link{results}} function can be used
+to generate other comparisons.
+
+The Wald test can be replaced with the \code{\link{nbinomLRT}}
+for an alternative test of significance.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+dds <- nbinomWaldTest(dds)
+res <- results(dds)
+
+}
+\seealso{
+\code{\link{DESeq}}, \code{\link{nbinomLRT}}
+}
+
diff --git a/man/normTransform.Rd b/man/normTransform.Rd
new file mode 100644
index 0000000..8e832a5
--- /dev/null
+++ b/man/normTransform.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\name{normTransform}
+\alias{normTransform}
+\title{Normalized counts transformation}
+\usage{
+normTransform(object, f = log2, pc = 1)
+}
+\arguments{
+\item{object}{a DESeqDataSet object}
+
+\item{f}{a function to apply to normalized counts}
+
+\item{pc}{a pseudocount to add to normalized counts}
+}
+\description{
+A simple function for creating a \code{\link{DESeqTransform}}
+object after applying: f(count + pc).
+}
+\seealso{
+\code{\link{varianceStabilizingTransformation}}, \code{\link{rlog}}
+}
+
diff --git a/man/normalizationFactors.Rd b/man/normalizationFactors.Rd
new file mode 100644
index 0000000..6574a75
--- /dev/null
+++ b/man/normalizationFactors.Rd
@@ -0,0 +1,64 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllGenerics.R, R/methods.R
+\docType{methods}
+\name{normalizationFactors}
+\alias{normalizationFactors}
+\alias{normalizationFactors,DESeqDataSet-method}
+\alias{normalizationFactors<-}
+\alias{normalizationFactors<-,DESeqDataSet,matrix-method}
+\title{Accessor functions for the normalization factors in a DESeqDataSet
+object.}
+\usage{
+normalizationFactors(object, ...)
+
+normalizationFactors(object, ...) <- value
+
+\S4method{normalizationFactors}{DESeqDataSet}(object)
+
+\S4method{normalizationFactors}{DESeqDataSet,matrix}(object) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object.}
+
+\item{...}{additional arguments}
+
+\item{value}{the matrix of normalization factors}
+}
+\description{
+Gene-specific normalization factors for each sample can be provided as a matrix,
+which will preempt \code{\link{sizeFactors}}. In some experiments, counts for each
+sample have varying dependence on covariates, e.g. on GC-content for sequencing
+data run on different days, and in this case it makes sense to provide
+gene-specific factors for each sample rather than a single size factor.
+}
+\details{
+Normalization factors alter the model of \code{\link{DESeq}} in the following way, for
+counts \eqn{K_{ij}}{K_ij} and normalization factors \eqn{NF_{ij}}{NF_ij} for gene i and sample j:
+
+\deqn{ K_{ij} \sim \textrm{NB}( \mu_{ij}, \alpha_i) }{ K_ij ~ NB(mu_ij, alpha_i) }
+\deqn{ \mu_{ij} = NF_{ij} q_{ij} }{ mu_ij = NF_ij q_ij }
+}
+\note{
+Normalization factors are on the scale of the counts (similar to \code{\link{sizeFactors}})
+and unlike offsets, which are typically on the scale of the predictors (in this case, log counts).
+Normalization factors should include library size normalization. They should have
+row-wise geometric mean near 1, as is the case with size factors, such that the mean of normalized
+counts is close to the mean of unnormalized counts. See example code below.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+
+normFactors <- matrix(runif(nrow(dds)*ncol(dds),0.5,1.5),
+ ncol=ncol(dds),nrow=nrow(dds),
+ dimnames=list(1:nrow(dds),1:ncol(dds)))
+
+# the normalization factors matrix should not have 0's in it
+# it should have geometric mean near 1 for each row
+normFactors <- normFactors / exp(rowMeans(log(normFactors)))
+normalizationFactors(dds) <- normFactors
+
+dds <- DESeq(dds)
+
+}
+
diff --git a/man/normalizeGeneLength.Rd b/man/normalizeGeneLength.Rd
new file mode 100644
index 0000000..916bfc4
--- /dev/null
+++ b/man/normalizeGeneLength.Rd
@@ -0,0 +1,107 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\name{normalizeGeneLength}
+\alias{normalizeGeneLength}
+\title{Normalize for gene length}
+\usage{
+normalizeGeneLength(object, files, level = c("tx", "gene"),
+ geneIdCol = "gene_id", lengthCol = "length", abundanceCol = "FPKM",
+ dropGenes = FALSE, importer, ...)
+}
+\arguments{
+\item{object}{the DESeqDataSet, before calling \code{DESeq}}
+
+\item{files}{a character vector specifying the filenames of output files
+containing either transcript abundance estimates with transcript length,
+or average transcript length information per gene.}
+
+\item{level}{either "tx" or "gene"}
+
+\item{geneIdCol}{the name of the column of the files specifying the gene id. This
+should line up with the \code{rownames(object)}. The information in the files
+will be re-ordered to line up with the rownames of the object.
+See \code{dropGenes} for more details.}
+
+\item{lengthCol}{the name of the column of files specifying the length of the
+feature, either transcript for \code{level="tx"} or the gene for
+\code{level="gene"}.}
+
+\item{abundanceCol}{only needed if \code{level="tx"}, the name of the
+column specifying the abundance estimate of the transcript.}
+
+\item{dropGenes}{whether to drop genes from the object,
+as labelled by \code{rownames(object)}, which are not
+present in the \code{geneIdCol} of the files. Defaults to FALSE
+and gives an error upon finding \code{rownames} of the object
+not present in the \code{geneIdCol} of the files.
+The function will reorder the matching rows of the files to match
+the rownames of the object.}
+
+\item{importer}{a function to read the \code{files}.
+\code{fread} from the data.table package is quite fast,
+but other options include \code{read.table}, \code{read.csv}.
+One can pre-test with \code{importer(files[1])}.}
+
+\item{...}{further arguments passed to \code{importer}}
+}
+\value{
+a DESeqDataSet with \code{\link{normalizationFactors}}
+accounting for average transcript length and library size
+}
+\description{
+Normalize for gene length using the output of transcript abundance estimators
+}
+\details{
+This is a prototype function for importing information about changes in
+the average transcript length for each gene. The use of this function
+is only for testing purposes.
+
+The function simply imports or calculates average
+transcript length for each gene and each sample from external files,
+and provides this matrix to the \code{normMatrix} argument of
+\code{\link{estimateSizeFactors}}.
+By average transcript length, the average refers to a weighted average with respect
+to the transcript abundances. The RSEM method includes such a column in their
+\code{gene.results} files, but an estimate of average transcript length can
+be obtained from any software which outputs a file with a row for each
+transcript, specifying: transcript length, estimate of transcript abundance,
+and the gene which the transcript belongs to.
+
+Normalization factors accounting for both average transcript length and
+library size of each sample are generated and then stored within the data object.
+The analysis can then continue with \code{\link{DESeq}};
+the stored normalization factors will be used instead of size factors in the analysis.
+
+For RSEM \code{genes.results} files,
+specify \code{level="gene"}, \code{geneIdCol="gene_id"},
+and \code{lengthCol="effective_length"}
+
+For Cufflinks \code{isoforms.fpkm_tracking} files,
+specify \code{level="tx"}, \code{geneIdCol="gene_id"},
+\code{lengthCol="length"}, and \code{abundanceCol="FPKM"}.
+
+For Sailfish output files, one can write an \code{importer}
+function which attaches a column \code{gene_id} based on Transcript ID,
+and then specify \code{level="tx"}, \code{geneIdCol="gene_id"},
+\code{lengthCol="Length"} and \code{abundanceCol="RPKM"}.
+
+Along with the normalization matrix which is stored in \code{normalizationFactors(object)},
+the resulting gene length matrix is stored in \code{assays(dds)[["avgTxLength"]]},
+and will take precedence in calls to \code{\link{fpkm}}.
+}
+\examples{
+
+n <- 10
+files <- c("sample1","sample2")
+gene_id <- rep(paste0("gene",seq_len(n)),each=3)
+set.seed(1)
+sample1 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+sample2 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+importer <- get
+dds <- makeExampleDESeqDataSet(n=n, m=2)
+dds <- normalizeGeneLength(dds, files=files, level="tx",
+ geneIdCol="gene_id", lengthCol="length", abundanceCol="FPKM",
+ dropGenes=TRUE, importer=importer)
+
+}
+
diff --git a/man/plotCounts.Rd b/man/plotCounts.Rd
new file mode 100644
index 0000000..6be972a
--- /dev/null
+++ b/man/plotCounts.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plots.R
+\name{plotCounts}
+\alias{plotCounts}
+\title{Plot of normalized counts for a single gene on log scale}
+\usage{
+plotCounts(dds, gene, intgroup = "condition", normalized = TRUE,
+ transform = FALSE, main, xlab = "group", returnData = FALSE,
+ replaced = FALSE, ...)
+}
+\arguments{
+\item{dds}{a \code{DESeqDataSet}}
+
+\item{gene}{a character, specifying the name of the gene to plot}
+
+\item{intgroup}{interesting groups: a character vector of names in \code{colData(x)} to use for grouping}
+
+\item{normalized}{whether the counts should be normalized by size factor
+(default is TRUE)}
+
+\item{transform}{whether to present log2 counts (TRUE) or
+to present the counts on the log scale (FALSE, default)}
+
+\item{main}{as in 'plot'}
+
+\item{xlab}{as in 'plot'}
+
+\item{returnData}{should the function only return the data.frame of counts and
+covariates for custom plotting (default is FALSE)}
+
+\item{replaced}{use the outlier-replaced counts if they exist}
+
+\item{...}{arguments passed to plot}
+}
+\description{
+Note: normalized counts plus a pseudocount of 0.5 are shown.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+plotCounts(dds, "gene1")
+
+}
+
diff --git a/man/plotDispEsts.Rd b/man/plotDispEsts.Rd
new file mode 100644
index 0000000..cce5e1c
--- /dev/null
+++ b/man/plotDispEsts.Rd
@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plots.R
+\docType{methods}
+\name{plotDispEsts}
+\alias{plotDispEsts}
+\alias{plotDispEsts,DESeqDataSet-method}
+\title{Plot dispersion estimates}
+\usage{
+\S4method{plotDispEsts}{DESeqDataSet}(object, ymin, genecol = "black",
+ fitcol = "red", finalcol = "dodgerblue", legend = TRUE, xlab, ylab,
+ log = "xy", cex = 0.45, ...)
+}
+\arguments{
+\item{object}{a DESeqDataSet, with dispersions estimated}
+
+\item{ymin}{the lower bound for points on the plot, points beyond this
+are drawn as triangles at ymin}
+
+\item{genecol}{the color for gene-wise dispersion estimates}
+
+\item{fitcol}{the color of the fitted estimates}
+
+\item{finalcol}{the color of the final estimates used for testing}
+
+\item{legend}{logical, whether to draw a legend}
+
+\item{xlab}{xlab}
+
+\item{ylab}{ylab}
+
+\item{log}{log}
+
+\item{cex}{cex}
+
+\item{...}{further arguments to \code{plot}}
+}
+\description{
+A simple helper function that plots the per-gene dispersion
+estimates together with the fitted mean-dispersion relationship.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+plotDispEsts(dds)
+
+}
+\author{
+Simon Anders
+}
+
diff --git a/man/plotMA.Rd b/man/plotMA.Rd
new file mode 100644
index 0000000..30a22cb
--- /dev/null
+++ b/man/plotMA.Rd
@@ -0,0 +1,62 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plots.R
+\docType{methods}
+\name{plotMA}
+\alias{plotMA}
+\alias{plotMA,DESeqDataSet-method}
+\alias{plotMA,DESeqResults-method}
+\title{MA-plot from base means and log fold changes}
+\usage{
+\S4method{plotMA}{DESeqDataSet}(object, alpha = 0.1, main = "", ylim, ...)
+
+\S4method{plotMA}{DESeqResults}(object, alpha, main = "", ylim, MLE = FALSE,
+ ...)
+}
+\arguments{
+\item{object}{a \code{DESeqResults} object produced by \code{\link{results}};
+or a \code{DESeqDataSet} processed by \code{\link{DESeq}}, or the
+individual functions \code{\link{nbinomWaldTest}} or \code{\link{nbinomLRT}}}
+
+\item{alpha}{the significance level for thresholding adjusted p-values}
+
+\item{main}{optional title for the plot}
+
+\item{ylim}{optional y limits}
+
+\item{...}{further arguments passed to \code{plotMA} if object
+is \code{DESeqResults} or to \code{\link{results}} if object is
+\code{DESeqDataSet}}
+
+\item{MLE}{whether to plot the MLE (unshrunken estimates), defaults to FALSE.
+Requires that \code{\link{results}} was run with \code{addMLE=TRUE}.
+Note that the MLE will be plotted regardless of this argument, if DESeq() was run
+with \code{betaPrior=FALSE}.}
+}
+\description{
+A simple helper function that makes a so-called "MA-plot", i.e. a
+scatter plot of log2 fold changes (on the y-axis) versus the mean of
+normalized counts (on the x-axis).
+}
+\details{
+This function is essentially two lines of code: building a
+\code{data.frame} and passing this to the \code{plotMA} method
+for \code{data.frame} from the geneplotter package.
+The code of this function can be seen with:
+\code{getMethod("plotMA","DESeqDataSet")}
+If users wish to modify the graphical parameters of the plot,
+it is recommended to build the data.frame in the
+same manner and call \code{plotMA}.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet()
+dds <- DESeq(dds)
+plotMA(dds)
+res <- results(dds)
+plotMA(res)
+
+}
+\author{
+Michael Love
+}
+
diff --git a/man/plotPCA.Rd b/man/plotPCA.Rd
new file mode 100644
index 0000000..c69592f
--- /dev/null
+++ b/man/plotPCA.Rd
@@ -0,0 +1,60 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plots.R
+\docType{methods}
+\name{plotPCA}
+\alias{plotPCA}
+\alias{plotPCA,DESeqTransform-method}
+\title{Sample PCA plot for transformed data}
+\usage{
+\S4method{plotPCA}{DESeqTransform}(object, intgroup = "condition",
+ ntop = 500, returnData = FALSE)
+}
+\arguments{
+\item{object}{a \code{\link{DESeqTransform}} object, with data in \code{assay(x)},
+produced for example by either \code{\link{rlog}} or
+\code{\link{varianceStabilizingTransformation}}.}
+
+\item{intgroup}{interesting groups: a character vector of
+names in \code{colData(x)} to use for grouping}
+
+\item{ntop}{number of top genes to use for principal components,
+selected by highest row variance}
+
+\item{returnData}{should the function only return the data.frame of PC1 and PC2
+with intgroup covariates for custom plotting (default is FALSE)}
+}
+\value{
+An object created by \code{ggplot}, which can be assigned and further customized.
+}
+\description{
+This plot helps to check for batch effects and the like.
+}
+\note{
+See the vignette for an example of variance stabilization and PCA plots.
+Note that the source code of \code{plotPCA} is very simple.
+The source can be found by typing \code{DESeq2:::plotPCA.DESeqTransform}
+or \code{getMethod("plotPCA","DESeqTransform")}, or
+browsed on github at \url{https://github.com/Bioconductor-mirror/DESeq2/blob/master/R/plots.R}
+Users should find it easy to customize this function.
+}
+\examples{
+
+# using rlog transformed data:
+dds <- makeExampleDESeqDataSet(betaSD=1)
+rld <- rlog(dds)
+plotPCA(rld)
+
+# also possible to perform custom transformation:
+dds <- estimateSizeFactors(dds)
+# shifted log of normalized counts
+se <- SummarizedExperiment(log2(counts(dds, normalized=TRUE) + 1),
+ colData=colData(dds))
+# the call to DESeqTransform() is needed to
+# trigger our plotPCA method.
+plotPCA( DESeqTransform( se ) )
+
+}
+\author{
+Wolfgang Huber
+}
+
diff --git a/man/plotSparsity.Rd b/man/plotSparsity.Rd
new file mode 100644
index 0000000..b537b2f
--- /dev/null
+++ b/man/plotSparsity.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plots.R
+\name{plotSparsity}
+\alias{plotSparsity}
+\title{Sparsity plot}
+\usage{
+plotSparsity(x, normalized = TRUE, ...)
+}
+\arguments{
+\item{x}{a matrix or DESeqDataSet}
+
+\item{normalized}{whether to normalize the counts from a DESeqDataSEt}
+
+\item{...}{passed to \code{plot}}
+}
+\description{
+A simple plot of the concentration of counts in a single sample over the
+sum of counts per gene. Not technically the same as "sparsity", but this
+plot is useful diagnostic for datasets which might not fit a negative
+binomial assumption: genes with many zeros and individual very large
+counts are difficult to model with the negative binomial distribution.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(n=1000,m=4,dispMeanRel=function(x) .5)
+dds <- estimateSizeFactors(dds)
+plotSparsity(dds)
+
+}
+
diff --git a/man/replaceOutliers.Rd b/man/replaceOutliers.Rd
new file mode 100644
index 0000000..7370459
--- /dev/null
+++ b/man/replaceOutliers.Rd
@@ -0,0 +1,72 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/core.R
+\name{replaceOutliers}
+\alias{replaceOutliers}
+\alias{replaceOutliersWithTrimmedMean}
+\title{Replace outliers with trimmed mean}
+\usage{
+replaceOutliers(object, trim = 0.2, cooksCutoff, minReplicates = 7,
+ whichSamples)
+
+replaceOutliersWithTrimmedMean(object, trim = 0.2, cooksCutoff,
+ minReplicates = 7, whichSamples)
+}
+\arguments{
+\item{object}{a DESeqDataSet object, which has already been processed by
+either DESeq, nbinomWaldTest or nbinomLRT, and therefore contains a matrix
+contained in \code{assays(dds)[["cooks"]]}. These are the Cook's distances which will
+be used to define outlier counts.}
+
+\item{trim}{the fraction (0 to 0.5) of observations to be trimmed from
+each end of the normalized counts for a gene before the mean is computed}
+
+\item{cooksCutoff}{the threshold for defining an outlier to be replaced.
+Defaults to the .99 quantile of the F(p, m - p) distribution, where p is
+the number of parameters and m is the number of samples.}
+
+\item{minReplicates}{the minimum number of replicate samples necessary to consider
+a sample eligible for replacement (including itself). Outlier counts will not be replaced
+if the sample is in a cell which has less than minReplicates replicates.}
+
+\item{whichSamples}{optional, a numeric or logical index to specify
+which samples should have outliers replaced. if missing, this is determined using
+minReplicates.}
+}
+\value{
+a DESeqDataSet with replaced counts in the slot returned by
+\code{\link{counts}} and the original counts preserved in
+\code{assays(dds)[["originalCounts"]]}
+}
+\description{
+Note that this function is called within \code{\link{DESeq}}, so is not
+necessary to call on top of a \code{DESeq} call. See the \code{minReplicatesForReplace}
+argument documented in \code{link{DESeq}}.
+}
+\details{
+This function replaces outlier counts flagged by extreme Cook's distances,
+as calculated by \code{\link{DESeq}}, \code{\link{nbinomWaldTest}}
+or \code{\link{nbinomLRT}}, with values predicted by the trimmed mean
+over all samples (and adjusted by size factor or normalization factor).
+This function replaces the counts in the matrix returned by \code{counts(dds)}
+and the Cook's distances in \code{assays(dds)[["cooks"]]}. Original counts are
+preserved in \code{assays(dds)[["originalCounts"]]}.
+
+The \code{\link{DESeq}} function calculates a diagnostic measure called
+Cook's distance for every gene and every sample. The \code{\link{results}}
+function then sets the p-values to \code{NA} for genes which contain
+an outlying count as defined by a Cook's distance above a threshold.
+With many degrees of freedom, i.e. many more samples than number of parameters to
+be estimated-- it might be undesirable to remove entire genes from the analysis
+just because their data include a single count outlier.
+An alternate strategy is to replace the outlier counts
+with the trimmed mean over all samples, adjusted by the size factor or normalization
+factor for that sample. The following simple function performs this replacement
+for the user, for samples which have at least \code{minReplicates} number
+of replicates (including that sample).
+For more information on Cook's distance, please see the two
+sections of the vignette: 'Dealing with count outliers' and 'Count outlier detection'.
+}
+\seealso{
+\code{\link{DESeq}}
+}
+
diff --git a/man/results.Rd b/man/results.Rd
new file mode 100644
index 0000000..53b5c07
--- /dev/null
+++ b/man/results.Rd
@@ -0,0 +1,309 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/results.R
+\name{results}
+\alias{removeResults}
+\alias{results}
+\alias{resultsNames}
+\title{Extract results from a DESeq analysis}
+\usage{
+results(object, contrast, name, lfcThreshold = 0,
+ altHypothesis = c("greaterAbs", "lessAbs", "greater", "less"),
+ listValues = c(1, -1), cooksCutoff, independentFiltering = TRUE,
+ alpha = 0.1, filter, theta, pAdjustMethod = "BH", filterFun,
+ format = c("DataFrame", "GRanges", "GRangesList"), test, addMLE = FALSE,
+ tidy = FALSE, parallel = FALSE, BPPARAM = bpparam())
+
+resultsNames(object)
+
+removeResults(object)
+}
+\arguments{
+\item{object}{a DESeqDataSet, on which one
+of the following functions has already been called:
+\code{\link{DESeq}}, \code{\link{nbinomWaldTest}}, or \code{\link{nbinomLRT}}}
+
+\item{contrast}{this argument specifies what comparison to extract from
+the \code{object} to build a results table. one of either:
+\itemize{
+ \item a character vector with exactly three elements:
+the name of a factor in the design formula,
+the name of the numerator level for the fold change,
+and the name of the denominator level for the fold change
+(simplest case)
+ \item a list of 2 character vectors: the names of the fold changes
+for the numerator, and the names of the fold changes
+for the denominator.
+these names should be elements of \code{resultsNames(object)}.
+if the list is length 1, a second element is added which is the
+empty character vector, \code{character()}.
+(more general case, can be to combine interaction terms and main effects)
+ \item a numeric contrast vector with one element
+for each element in \code{resultsNames(object)} (most general case)
+}
+If specified, the \code{name} argument is ignored.}
+
+\item{name}{the name of the individual effect (coefficient) for
+building a results table. Use this argument rather than \code{contrast}
+for continuous variables, individual effects or for individual interaction terms.
+The value provided to \code{name} must be an element of \code{resultsNames(object)}.}
+
+\item{lfcThreshold}{a non-negative value, which specifies the test which should
+be applied to the log2 fold changes. The standard is a test that the log2 fold
+changes are not equal to zero. However, log2 fold changes greater or less than
+\code{lfcThreshold} can also be tested. Specify the alternative hypothesis
+using the \code{altHypothesis} argument. If \code{lfcThreshold} is specified,
+the results are Wald tests, and LRT p-values will be overwritten.}
+
+\item{altHypothesis}{character which specifies the alternative hypothesis,
+i.e. those values of log2 fold change which the user is interested in
+finding. The complement of this set of values is the null hypothesis which
+will be tested. If the log2 fold change specified by \code{name}
+or by \code{contrast} is written as \eqn{ \beta }{ beta }, then the possible values for
+\code{altHypothesis} represent the following alternate hypotheses:
+\itemize{
+\item greaterAbs: \eqn{|\beta| > \textrm{lfcThreshold} }{ |beta| > lfcThreshold },
+and p-values are two-tailed
+\item lessAbs: \eqn{ |\beta| < \textrm{lfcThreshold} }{ |beta| < lfcThreshold },
+NOTE: this requires that \code{betaPrior=FALSE} has been specified in the
+previous \code{\link{DESeq}} call.
+p-values are the maximum of the upper and lower tests.
+\item greater: \eqn{ \beta > \textrm{lfcThreshold} }{ beta > lfcThreshold }
+\item less: \eqn{ \beta < -\textrm{lfcThreshold} }{ beta < -lfcThreshold }
+}}
+
+\item{listValues}{only used if a list is provided to \code{contrast}:
+a numeric of length two: the log2 fold changes in the list are multiplied by these values.
+the first number should be positive and the second negative.
+by default this is \code{c(1,-1)}}
+
+\item{cooksCutoff}{theshold on Cook's distance, such that if one or more
+samples for a row have a distance higher, the p-value for the row is
+set to NA.
+The default cutoff is the .99 quantile of the F(p, m-p) distribution,
+where p is the number of coefficients being fitted and m is the number of samples.
+Set to Inf or FALSE to disable the resetting of p-values to NA.
+Note: this test excludes the Cook's distance of samples belonging to experimental
+groups with only 2 samples.}
+
+\item{independentFiltering}{logical, whether independent filtering should be
+applied automatically}
+
+\item{alpha}{the significance cutoff used for optimizing the independent
+filtering (by default 0.1). If the adjusted p-value cutoff (FDR) will be a
+value other than 0.1, \code{alpha} should be set to that value.}
+
+\item{filter}{the vector of filter statistics over which the independent
+filtering will be optimized. By default the mean of normalized counts is used.}
+
+\item{theta}{the quantiles at which to assess the number of rejections
+from independent filtering}
+
+\item{pAdjustMethod}{the method to use for adjusting p-values, see \code{?p.adjust}}
+
+\item{filterFun}{an optional custom function for independent filtering,
+with arguments \code{alpha}, \code{filter}, \code{test}, \code{theta}, and \code{method}
+similar to \code{genefilter::filtered_R}, and which returns \code{padj}}
+
+\item{format}{character, either \code{"DataFrame"}, \code{"GRanges"}, or \code{"GRangesList"},
+whether the results should be printed as a \code{\link{DESeqResults}} DataFrame,
+or if the results DataFrame should be attached as metadata columns to
+the \code{GRanges} or \code{GRangesList} \code{rowRanges} of the \code{DESeqDataSet}.
+If the \code{rowRanges} is a \code{GRangesList}, and \code{GRanges} is requested,
+the range of each gene will be returned}
+
+\item{test}{this is typically automatically detected internally.
+the one exception is after \code{nbinomLRT} has been run, \code{test="Wald"}
+will generate Wald statistics and Wald test p-values.}
+
+\item{addMLE}{whether the "unshrunken" maximum likelihood estimates (MLE)
+of log2 fold change should be added as a column to the results table (default is FALSE).
+only applicable when a beta prior was used during the model fitting. only implemented
+for 'contrast' for three element character vectors or 'name' for interactions.}
+
+\item{tidy}{whether to output the results table with rownames as a first column 'row'.
+the table will also be coerced to \code{data.frame}}
+
+\item{parallel}{if FALSE, no parallelization. if TRUE, parallel
+execution using \code{BiocParallel}, see next argument \code{BPPARAM}}
+
+\item{BPPARAM}{an optional parameter object passed internally
+to \code{\link{bplapply}} when \code{parallel=TRUE}.
+If not specified, the parameters last registered with
+\code{\link{register}} will be used.}
+}
+\value{
+For \code{results}: a \code{\link{DESeqResults}} object, which is
+a simple subclass of DataFrame. This object contains the results columns:
+\code{baseMean}, \code{log2FoldChange}, \code{lfcSE}, \code{stat},
+\code{pvalue} and \code{padj},
+and also includes metadata columns of variable information.
+The \code{lfcSE} gives the standard error of the \code{log2FoldChange}.
+For the Wald test, \code{stat} is the Wald statistic: the \code{log2FoldChange}
+divided by \code{lfcSE}, which is compared to a standard Normal distribution
+to generate a two-tailed \code{pvalue}. For the likelihood ratio test (LRT),
+\code{stat} is the difference in deviance between the reduced model and the full model,
+which is compared to a chi-squared distribution to generate a \code{pvalue}.
+
+For \code{resultsNames}: the names of the columns available as results,
+usually a combination of the variable name and a level
+
+For \code{removeResults}: the original \code{DESeqDataSet} with results metadata columns removed
+}
+\description{
+\code{results} extracts a result table from a DESeq analysis giving base means across samples,
+log2 fold changes, standard errors, test statistics, p-values and adjusted p-values;
+\code{resultsNames} returns the names of the estimated effects (coefficents) of the model;
+\code{removeResults} returns a \code{DESeqDataSet} object with results columns removed.
+}
+\details{
+The results table when printed will provide the information about
+the comparison, e.g. "log2 fold change (MAP): condition treated vs untreated", meaning
+that the estimates are of log2(treated / untreated), as would be returned by
+\code{contrast=c("condition","treated","untreated")}.
+Multiple results can be returned for analyses beyond a simple two group comparison,
+so \code{results} takes arguments \code{contrast} and \code{name} to help
+the user pick out the comparisons of interest for printing a results table.
+The use of the \code{contrast} argument is recommended for exact specification
+of the levels which should be compared and their order.
+
+If \code{results} is run without specifying \code{contrast} or \code{name},
+it will return the comparison of the last level of the last variable in the
+design formula over the first level of this variable. For example, for a simple two-group
+comparison, this would return the log2 fold changes of the second group over the
+first group (the reference level). Please see examples below and in the vignette.
+
+The argument \code{contrast} can be used to generate results tables for
+any comparison of interest, for example, the log2 fold change between
+two levels of a factor, and its usage is described below. It can also
+accomodate more complicated numeric comparisons.
+The test statistic used for a contrast is:
+
+\deqn{ c^t \beta / \sqrt{c^t \Sigma c } }{ c' beta / sqrt( c' Sigma c ) }
+
+The argument \code{name} can be used to generate results tables for
+individual effects, which must be individual elements of \code{resultsNames(object)}.
+These individual effects could represent continuous covariates, effects
+for individual levels, or individual interaction effects.
+
+Information on the comparison which was used to build the results table,
+and the statistical test which was used for p-values (Wald test or likelihood ratio test)
+is stored within the object returned by \code{results}. This information is in
+the metadata columns of the results table, which is accessible by calling \code{mcols}
+on the \code{\link{DESeqResults}} object returned by \code{results}.
+
+On p-values:
+
+By default, independent filtering is performed to select a set of genes
+for multiple test correction which maximizes the number of adjusted
+p-values less than a given critical value \code{alpha} (by default 0.1).
+The filter used for maximizing the number of rejections is the mean
+of normalized counts for all samples in the dataset.
+In version >= 1.10, the threshold chosen is
+the lowest quantile of the filter for which the
+number of rejections is close to the peak of a curve fit
+to the number of rejections over the filter quantiles.
+'Close to' is defined as within 1 residual standard deviation.
+
+The adjusted p-values for the genes which do not pass the filter threshold
+are set to \code{NA}. By default, the mean of normalized counts
+is used to perform this filtering, though other statistics can be provided.
+Several arguments from the \code{filtered_p} function of genefilter
+are provided here to control or turn off the independent filtering behavior.
+
+By default, \code{results} assigns a p-value of \code{NA}
+to genes containing count outliers, as identified using Cook's distance.
+See the \code{cooksCutoff} argument for control of this behavior.
+Cook's distances for each sample are accessible as a matrix "cooks"
+stored in the \code{assays()} list. This measure is useful for identifying rows where the
+observed counts might not fit to a Negative Binomial distribution.
+
+For analyses using the likelihood ratio test (using \code{\link{nbinomLRT}}),
+the p-values are determined solely by the difference in deviance between
+the full and reduced model formula. A log2 fold change is included,
+which can be controlled using the \code{name} argument, or by default this will
+be the estimated coefficient for the last element of \code{resultsNames(object)}.
+}
+\examples{
+
+## Example 1: simple two-group comparison
+
+dds <- makeExampleDESeqDataSet(m=4)
+
+dds <- DESeq(dds)
+res <- results(dds)
+res[ order(res$padj), ]
+
+## Example 2: two conditions, two genotypes, with an interaction term
+
+dds <- makeExampleDESeqDataSet(n=100,m=12)
+dds$genotype <- factor(rep(rep(c("I","II"),each=3),2))
+
+design(dds) <- ~ genotype + condition + genotype:condition
+dds <- DESeq(dds)
+resultsNames(dds)
+
+# Note: design with interactions terms by default have betaPrior=FALSE
+
+# the condition effect for genotype I (the main effect)
+results(dds, contrast=c("condition","B","A"))
+
+# the condition effect for genotype II
+# this is, by definition, the main effect *plus* the interaction term
+# (the extra condition effect in genotype II compared to genotype I).
+results(dds, list( c("condition_B_vs_A","genotypeII.conditionB") ))
+
+# the interaction term, answering: is the condition effect *different* across genotypes?
+results(dds, name="genotypeII.conditionB")
+
+## Example 3: two conditions, three genotypes
+
+# ~~~ Using interaction terms ~~~
+
+dds <- makeExampleDESeqDataSet(n=100,m=18)
+dds$genotype <- factor(rep(rep(c("I","II","III"),each=3),2))
+design(dds) <- ~ genotype + condition + genotype:condition
+dds <- DESeq(dds)
+resultsNames(dds)
+
+# the condition effect for genotype I (the main effect)
+results(dds, contrast=c("condition","B","A"))
+
+# the condition effect for genotype III.
+# this is the main effect *plus* the interaction term
+# (the extra condition effect in genotype III compared to genotype I).
+results(dds, contrast=list( c("condition_B_vs_A","genotypeIII.conditionB") ))
+
+# the interaction term for condition effect in genotype III vs genotype I.
+# this tests if the condition effect is different in III compared to I
+results(dds, name="genotypeIII.conditionB")
+
+# the interaction term for condition effect in genotype III vs genotype II.
+# this tests if the condition effect is different in III compared to II
+results(dds, contrast=list("genotypeIII.conditionB", "genotypeII.conditionB"))
+
+# Note that a likelihood ratio could be used to test if there are any
+# differences in the condition effect between the three genotypes.
+
+# ~~~ Using a grouping variable ~~~
+
+# This is a useful construction when users just want to compare
+# specific groups which are combinations of variables.
+
+dds$group <- factor(paste0(dds$genotype, dds$condition))
+design(dds) <- ~ group
+dds <- DESeq(dds)
+resultsNames(dds)
+
+# the condition effect for genotypeIII
+results(dds, contrast=c("group", "IIIB", "IIIA"))
+
+}
+\references{
+Richard Bourgon, Robert Gentleman, Wolfgang Huber: Independent
+filtering increases detection power for high-throughput experiments.
+PNAS (2010), \url{http://dx.doi.org/10.1073/pnas.0914005107}
+}
+\seealso{
+\code{\link{DESeq}}
+}
+
diff --git a/man/rlog.Rd b/man/rlog.Rd
new file mode 100644
index 0000000..8bb50a8
--- /dev/null
+++ b/man/rlog.Rd
@@ -0,0 +1,136 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/rlog.R
+\name{rlog}
+\alias{rlog}
+\alias{rlogTransformation}
+\title{Apply a 'regularized log' transformation}
+\usage{
+rlog(object, blind = TRUE, intercept, betaPriorVar, fitType = "parametric")
+
+rlogTransformation(object, blind = TRUE, intercept, betaPriorVar,
+ fitType = "parametric")
+}
+\arguments{
+\item{object}{a DESeqDataSet, or matrix of counts}
+
+\item{blind}{logical, whether to blind the transformation to the experimental
+design. blind=TRUE should be used for comparing samples in an manner unbiased by
+prior information on samples, for example to perform sample QA (quality assurance).
+blind=FALSE should be used for transforming data for downstream analysis,
+where the full use of the design information should be made.
+blind=FALSE will skip re-estimation of the dispersion trend, if this has already been calculated.
+If many of genes have large differences in counts due to
+the experimental design, it is important to set blind=FALSE for downstream
+analysis.}
+
+\item{intercept}{by default, this is not provided and calculated automatically.
+if provided, this should be a vector as long as the number of rows of object,
+which is log2 of the mean normalized counts from a previous dataset.
+this will enforce the intercept for the GLM, allowing for a "frozen" rlog
+transformation based on a previous dataset.
+You will also need to provide \code{mcols(object)$dispFit}.}
+
+\item{betaPriorVar}{a single value, the variance of the prior on the sample
+betas, which if missing is estimated from the data}
+
+\item{fitType}{in case dispersions have not yet been estimated for \code{object},
+this parameter is passed on to \code{\link{estimateDispersions}} (options described there).}
+}
+\value{
+a \code{\link{DESeqTransform}} if a \code{DESeqDataSet} was provided,
+or a matrix if a count matrix was provided as input.
+Note that for \code{\link{DESeqTransform}} output, the matrix of
+transformed values is stored in \code{assay(rld)}.
+To avoid returning matrices with NA values, in the case of a row
+of all zeros, the rlog transformation returns zeros
+(essentially adding a pseudocount of 1 only to these rows).
+}
+\description{
+This function transforms the count data to the log2 scale in a way
+which minimizes differences between samples for rows with small counts,
+and which normalizes with respect to library size.
+The rlog transformation produces a similar variance stabilizing effect as
+\code{\link{varianceStabilizingTransformation}},
+though \code{rlog} is more robust in the
+case when the size factors vary widely.
+The transformation is useful when checking for outliers
+or as input for machine learning techniques
+such as clustering or linear discriminant analysis.
+\code{rlog} takes as input a \code{\link{DESeqDataSet}} and returns a
+\code{\link{RangedSummarizedExperiment}} object.
+}
+\details{
+Note that neither rlog transformation nor the VST are used by the
+differential expression estimation in \code{\link{DESeq}}, which always
+occurs on the raw count data, through generalized linear modeling which
+incorporates knowledge of the variance-mean dependence. The rlog transformation
+and VST are offered as separate functionality which can be used for visualization,
+clustering or other machine learning tasks. See the transformation section of the
+vignette for more details.
+
+The transformation does not require that one has already estimated size factors
+and dispersions.
+
+The regularization is on the log fold changes of the count for each sample
+over an intercept, for each gene. As nearby count values for low counts genes
+are almost as likely as the observed count, the rlog shrinkage is greater for low counts.
+For high counts, the rlog shrinkage has a much weaker effect.
+The fitted dispersions are used rather than the MAP dispersions
+(so similar to the \code{\link{varianceStabilizingTransformation}}).
+
+The prior variance for the shrinkag of log fold changes is calculated as follows:
+a matrix is constructed of the logarithm of the counts plus a pseudocount of 0.5,
+the log of the row means is then subtracted, leaving an estimate of
+the log fold changes per sample over the fitted value using only an intercept.
+The prior variance is then calculated by matching the upper quantiles of the observed
+log fold change estimates with an upper quantile of the normal distribution.
+A GLM fit is then calculated using this prior. It is also possible to supply the variance of the prior.
+See the vignette for an example of the use and a comparison with \code{varianceStabilizingTransformation}.
+
+The transformed values, rlog(K), are equal to
+\eqn{rlog(K_{ij}) = \log_2(q_{ij}) = \beta_{i0} + \beta_{ij}}{rlog(K_ij) = log2(q_ij) = beta_i0 + beta_ij},
+with formula terms defined in \code{\link{DESeq}}.
+
+The parameters of the rlog transformation from a previous dataset
+can be frozen and reapplied to new samples. See the 'Data quality assessment'
+section of the vignette for strategies to see if new samples are
+sufficiently similar to previous datasets.
+The frozen rlog is accomplished by saving the dispersion function,
+beta prior variance and the intercept from a previous dataset,
+and running \code{rlog} with 'blind' set to FALSE
+(see example below).
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=6,betaSD=1)
+rld <- rlog(dds)
+dists <- dist(t(assay(rld)))
+plot(hclust(dists))
+
+# run the rlog transformation on one dataset
+design(dds) <- ~ 1
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+rld <- rlog(dds, blind=FALSE)
+
+# apply the parameters to a new sample
+
+ddsNew <- makeExampleDESeqDataSet(m=1)
+mcols(ddsNew)$dispFit <- mcols(dds)$dispFit
+betaPriorVar <- attr(rld,"betaPriorVar")
+intercept <- mcols(rld)$rlogIntercept
+rldNew <- rlog(ddsNew, blind=FALSE,
+ intercept=intercept,
+ betaPriorVar=betaPriorVar)
+
+
+}
+\references{
+Reference for regularized logarithm (rlog):
+
+Michael I Love, Wolfgang Huber, Simon Anders: Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2. Genome Biology 2014, 15:550. \url{http://dx.doi.org/10.1186/s13059-014-0550-8}
+}
+\seealso{
+\code{\link{plotPCA}}, \code{\link{varianceStabilizingTransformation}}, \code{\link{normTransform}}
+}
+
diff --git a/man/show.Rd b/man/show.Rd
new file mode 100644
index 0000000..12dd77d
--- /dev/null
+++ b/man/show.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{show}
+\alias{show}
+\alias{show,DESeqResults-method}
+\title{Show method for DESeqResults objects}
+\usage{
+\S4method{show}{DESeqResults}(object)
+}
+\arguments{
+\item{object}{a DESeqResults object}
+}
+\description{
+Prints out the information from the metadata columns
+of the results object regarding the log2 fold changes
+and p-values, then shows the DataFrame using the
+standard method.
+}
+\author{
+Michael Love
+}
+
diff --git a/man/sizeFactors.Rd b/man/sizeFactors.Rd
new file mode 100644
index 0000000..3c81eb2
--- /dev/null
+++ b/man/sizeFactors.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{sizeFactors}
+\alias{sizeFactors}
+\alias{sizeFactors,DESeqDataSet-method}
+\alias{sizeFactors<-,DESeqDataSet,numeric-method}
+\title{Accessor functions for the 'sizeFactors' information in a DESeqDataSet
+object.}
+\usage{
+\S4method{sizeFactors}{DESeqDataSet}(object)
+
+\S4method{sizeFactors}{DESeqDataSet,numeric}(object) <- value
+}
+\arguments{
+\item{object}{a \code{DESeqDataSet} object.}
+
+\item{value}{a numeric vector, one size factor for each column in the count
+data.}
+}
+\description{
+The sizeFactors vector assigns to each column of the count matrix a value, the
+size factor, such that count values in the columns can be brought to a common
+scale by dividing by the corresponding size factor (as performed by
+\code{counts(dds, normalized=TRUE)}).
+See \code{\link{DESeq}} for a description of the use of size factors. If gene-specific normalization
+is desired for each sample, use \code{\link{normalizationFactors}}.
+}
+\author{
+Simon Anders
+}
+\seealso{
+\code{\link{estimateSizeFactors}}
+}
+
diff --git a/man/summary.Rd b/man/summary.Rd
new file mode 100644
index 0000000..8162b35
--- /dev/null
+++ b/man/summary.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/methods.R
+\docType{methods}
+\name{summary}
+\alias{summary}
+\alias{summary.DESeqResults}
+\title{Summarize DESeq results}
+\usage{
+\method{summary}{DESeqResults}(object, alpha, \dots)
+}
+\arguments{
+\item{object}{a \code{\link{DESeqResults}} object}
+
+\item{alpha}{the adjusted p-value cutoff. if not set, this
+defaults to the \code{alpha} argument which was used in
+\code{\link{results}} to set the target FDR for independent
+filtering.}
+
+\item{...}{additional arguments}
+}
+\description{
+Print a summary of the results from a DESeq analysis.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=4)
+dds <- DESeq(dds)
+res <- results(dds)
+summary(res)
+
+}
+\author{
+Michael Love
+}
+
diff --git a/man/varianceStabilizingTransformation.Rd b/man/varianceStabilizingTransformation.Rd
new file mode 100644
index 0000000..d8610cf
--- /dev/null
+++ b/man/varianceStabilizingTransformation.Rd
@@ -0,0 +1,141 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/vst.R
+\name{varianceStabilizingTransformation}
+\alias{getVarianceStabilizedData}
+\alias{varianceStabilizingTransformation}
+\title{Apply a variance stabilizing transformation (VST) to the count data}
+\usage{
+varianceStabilizingTransformation(object, blind = TRUE,
+ fitType = "parametric")
+
+getVarianceStabilizedData(object)
+}
+\arguments{
+\item{object}{a DESeqDataSet or matrix of counts}
+
+\item{blind}{logical, whether to blind the transformation to the experimental
+design. blind=TRUE should be used for comparing samples in an manner unbiased by
+prior information on samples, for example to perform sample QA (quality assurance).
+blind=FALSE should be used for transforming data for downstream analysis,
+where the full use of the design information should be made.
+blind=FALSE will skip re-estimation of the dispersion trend, if this has already been calculated.
+If many of genes have large differences in counts due to
+the experimental design, it is important to set blind=FALSE for downstream
+analysis.}
+
+\item{fitType}{in case dispersions have not yet been estimated for \code{object},
+this parameter is passed on to \code{\link{estimateDispersions}} (options described there).}
+}
+\value{
+\code{varianceStabilizingTransformation} returns a
+\code{\link{DESeqTransform}} if a \code{DESeqDataSet} was provided,
+or returns a a matrix if a count matrix was provided.
+Note that for \code{\link{DESeqTransform}} output, the matrix of
+transformed values is stored in \code{assay(vsd)}.
+\code{getVarianceStabilizedData} also returns a matrix.
+}
+\description{
+This function calculates a variance stabilizing transformation (VST) from the
+fitted dispersion-mean relation(s) and then transforms the count data (normalized
+by division by the size factors or normalization factors), yielding a matrix
+of values which are now approximately homoskedastic (having constant variance along the range
+of mean values). The transformation also normalizes with respect to library size.
+The \code{\link{rlog}} is less sensitive
+to size factors, which can be an issue when size factors vary widely.
+These transformations are useful when checking for outliers or as input for
+machine learning techniques such as clustering or linear discriminant analysis.
+}
+\details{
+For each sample (i.e., column of \code{counts(dds)}), the full variance function
+is calculated from the raw variance (by scaling according to the size factor and adding
+the shot noise). We recommend a blind estimation of the variance function, i.e.,
+one ignoring conditions. This is performed by default, and can be modified using the
+'blind' argument.
+
+Note that neither rlog transformation nor the VST are used by the
+differential expression estimation in \code{\link{DESeq}}, which always
+occurs on the raw count data, through generalized linear modeling which
+incorporates knowledge of the variance-mean dependence. The rlog transformation
+and VST are offered as separate functionality which can be used for visualization,
+clustering or other machine learning tasks. See the transformation section of the
+vignette for more details.
+
+The transformation does not require that one has already estimated size factors
+and dispersions.
+
+A typical workflow is shown in Section \emph{Variance stabilizing transformation}
+in the package vignette.
+
+If \code{\link{estimateDispersions}} was called with:
+
+\code{fitType="parametric"},
+a closed-form expression for the variance stabilizing
+transformation is used on the normalized
+count data. The expression can be found in the file \file{vst.pdf}
+which is distributed with the vignette.
+
+\code{fitType="local"},
+the reciprocal of the square root of the variance of the normalized counts, as derived
+from the dispersion fit, is then numerically
+integrated, and the integral (approximated by a spline function) is evaluated for each
+count value in the column, yielding a transformed value.
+
+\code{fitType="mean"}, a VST is applied for Negative Binomial distributed counts, 'k',
+with a fixed dispersion, 'a': ( 2 asinh(sqrt(a k)) - log(a) - log(4) )/log(2).
+
+In all cases, the transformation is scaled such that for large
+counts, it becomes asymptotically (for large values) equal to the
+logarithm to base 2 of normalized counts.
+
+The variance stabilizing transformation from a previous dataset
+can be frozen and reapplied to new samples. See the 'Data quality assessment'
+section of the vignette for strategies to see if new samples are
+sufficiently similar to previous datasets.
+The frozen VST is accomplished by saving the dispersion function
+accessible with \code{\link{dispersionFunction}}, assigning this
+to the \code{DESeqDataSet} with the new samples, and running
+varianceStabilizingTransformation with 'blind' set to FALSE
+(see example below).
+Then the dispersion function from the previous dataset will be used
+to transform the new sample(s).
+
+Limitations: In order to preserve normalization, the same
+transformation has to be used for all samples. This results in the
+variance stabilizition to be only approximate. The more the size
+factors differ, the more residual dependence of the variance on the
+mean will be found in the transformed data. \code{\link{rlog}} is a
+transformation which can perform better in these cases.
+As shown in the vignette, the function \code{meanSdPlot}
+from the package \pkg{vsn} can be used to see whether this is a problem.
+}
+\examples{
+
+dds <- makeExampleDESeqDataSet(m=6)
+vsd <- varianceStabilizingTransformation(dds)
+dists <- dist(t(assay(vsd)))
+plot(hclust(dists))
+
+# learn the dispersion function of a dataset
+design(dds) <- ~ 1
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+
+# use the previous dispersion function for a new sample
+ddsNew <- makeExampleDESeqDataSet(m=1)
+ddsNew <- estimateSizeFactors(ddsNew)
+dispersionFunction(ddsNew) <- dispersionFunction(dds)
+vsdNew <- varianceStabilizingTransformation(ddsNew, blind=FALSE)
+
+}
+\author{
+Simon Anders
+}
+\references{
+Reference for the variance stabilizing transformation for counts with a dispersion trend:
+
+Simon Anders, Wolfgang Huber: Differential expression analysis for sequence count data. Genome Biology 2010, 11:106. \url{http://dx.doi.org/10.1186/gb-2010-11-10-r106}
+}
+\seealso{
+\code{\link{plotPCA}}, \code{\link{rlog}}, \code{\link{normTransform}}
+}
+
diff --git a/src/DESeq2.cpp b/src/DESeq2.cpp
new file mode 100644
index 0000000..7dc6560
--- /dev/null
+++ b/src/DESeq2.cpp
@@ -0,0 +1,393 @@
+// include RcppArmadillo and Rcpp
+#include "RcppArmadillo.h"
+
+using namespace Rcpp;
+
+// [[Rcpp::depends(RcppArmadillo)]]
+
+// user includes
+#include <R.h>
+#include <Rmath.h>
+#include <R_ext/Utils.h>
+
+// this function returns the log posterior of dispersion parameter alpha, for negative binomial variables
+// given the counts y, the expected means mu, the design matrix x (used for calculating the Cox-Reid adjustment),
+// and the parameters for the normal prior on log alpha
+double log_posterior(double log_alpha, Rcpp::NumericMatrix::Row y, Rcpp::NumericMatrix::Row mu, arma::mat x, double log_alpha_prior_mean, double log_alpha_prior_sigmasq, bool use_prior) {
+ double prior_part;
+ double alpha = exp(log_alpha);
+ Rcpp::NumericVector w_diag = pow(pow(mu, -1) + alpha, -1);
+ arma::mat w = arma::diagmat(Rcpp::as<arma::vec>(w_diag));
+ arma::mat b = x.t() * w * x;
+ double cr_term = -0.5 * log(det(b));
+ double alpha_neg1 = R_pow_di(alpha, -1);
+ double ll_part = sum(lgamma(y + alpha_neg1) - Rf_lgammafn(alpha_neg1) - y * log(mu + alpha_neg1) - alpha_neg1 * log(1.0 + mu * alpha));
+ if (use_prior) {
+ prior_part = -0.5 * R_pow_di(log_alpha - log_alpha_prior_mean,2)/log_alpha_prior_sigmasq;
+ } else {
+ prior_part = 0.0;
+ }
+ double res = ll_part + prior_part + cr_term;
+ return(res);
+}
+
+// this function returns the derivative of the log posterior with respect to the log of the
+// dispersion parameter alpha, given the same inputs as the previous function
+double dlog_posterior(double log_alpha, Rcpp::NumericMatrix::Row y, Rcpp::NumericMatrix::Row mu, arma::mat x, double log_alpha_prior_mean, double log_alpha_prior_sigmasq, bool use_prior) {
+ double prior_part;
+ double alpha = exp(log_alpha);
+ Rcpp::NumericVector w_diag = pow(pow(mu, -1) + alpha, -1);
+ arma::mat w = arma::diagmat(Rcpp::as<arma::vec>(w_diag));
+ Rcpp::NumericVector dw_diag = -1.0 * pow(pow(mu, -1) + alpha, -2);
+ arma::mat dw = arma::diagmat(Rcpp::as<arma::vec>(dw_diag));
+ arma::mat b = x.t() * w * x;
+ arma::mat db = x.t() * dw * x;
+ double ddetb = ( det(b) * trace(b.i(true) * db) );
+ double cr_term = -0.5 * ddetb / det(b);
+ double alpha_neg1 = R_pow_di(alpha, -1);
+ double alpha_neg2 = R_pow_di(alpha, -2);
+ double ll_part = alpha_neg2 * sum(Rf_digamma(alpha_neg1) + log(1 + mu*alpha) - mu*alpha*pow(1.0 + mu*alpha, -1) - digamma(y + alpha_neg1) + y * pow(mu + alpha_neg1, -1));
+ // only the prior part is w.r.t log alpha
+ if (use_prior) {
+ prior_part = -1.0 * (log_alpha - log_alpha_prior_mean)/log_alpha_prior_sigmasq;
+ } else {
+ prior_part = 0.0;
+ }
+ // Note: return dlog_post/dalpha * alpha because we take derivatives w.r.t log alpha
+ double res = (ll_part + cr_term) * alpha + prior_part;
+ return(res);
+}
+
+// this function returns the second derivative of the log posterior with respect to the log of the
+// dispersion parameter alpha, given the same inputs as the previous function
+double d2log_posterior(double log_alpha, Rcpp::NumericMatrix::Row y, Rcpp::NumericMatrix::Row mu, arma::mat x, double log_alpha_prior_mean, double log_alpha_prior_sigmasq, bool use_prior) {
+ double prior_part;
+ double alpha = exp(log_alpha);
+ Rcpp::NumericVector w_diag = pow(pow(mu, -1) + alpha, -1);
+ arma::mat w = arma::diagmat(as<arma::vec>(w_diag));
+ Rcpp::NumericVector dw_diag = -1 * pow(pow(mu, -1) + alpha, -2);
+ arma::mat dw = arma::diagmat(as<arma::vec>(dw_diag));
+ Rcpp::NumericVector d2w_diag = 2 * pow(pow(mu, -1) + alpha, -3);
+ arma::mat d2w = arma::diagmat(as<arma::vec>(d2w_diag));
+ arma::mat b = x.t() * w * x;
+ arma::mat b_i = b.i(true);
+ arma::mat db = x.t() * dw * x;
+ arma::mat d2b = x.t() * d2w * x;
+ double ddetb = ( det(b) * trace(b.i(true) * db) );
+ double d2detb = ( det(b) * (R_pow_di(trace(b_i * db), 2) - trace(b_i * db * b_i * db) + trace(b_i * d2b)) );
+ double cr_term = 0.5 * R_pow_di(ddetb/det(b), 2) - 0.5 * d2detb / det(b);
+ double alpha_neg1 = R_pow_di(alpha, -1);
+ double alpha_neg2 = R_pow_di(alpha, -2);
+ double ll_part = -2 * R_pow_di(alpha, -3) * sum(Rf_digamma(alpha_neg1) + log(1 + mu*alpha) - mu*alpha*pow(1 + mu*alpha, -1) - digamma(y + alpha_neg1) + y * pow(mu + alpha_neg1, -1)) + alpha_neg2 * sum(-1 * alpha_neg2 * Rf_trigamma(alpha_neg1) + pow(mu, 2) * alpha * pow(1 + mu*alpha, -2) + alpha_neg2 * trigamma(y + alpha_neg1) + alpha_neg2 * y * pow(mu + alpha_neg1, -2));
+ // only the prior part is w.r.t log alpha
+ if (use_prior) {
+ prior_part = -1.0/log_alpha_prior_sigmasq;
+ } else {
+ prior_part = 0.0;
+ }
+ // Note: return (d2log_post/dalpha2 * alpha^2 + dlog_post/dalpha * alpha)
+ // = (d2log_post/dalpha2 * alpha^2 + dlog_post/dlogalpha)
+ // because we take derivatives w.r.t log alpha
+ double res = ((ll_part + cr_term) * R_pow_di(alpha, 2) + dlog_posterior(log_alpha, y, mu, x, log_alpha_prior_mean, log_alpha_prior_sigmasq, false)) + prior_part;
+ return(res);
+}
+
+// Obtain the MLE or MAP dispersion estimate using line search.
+// fitting occurs on the scale of log(alpha)
+//
+// [[Rcpp::export]]
+Rcpp::List fitDisp(SEXP ySEXP, SEXP xSEXP, SEXP mu_hatSEXP, SEXP log_alphaSEXP, SEXP log_alpha_prior_meanSEXP, SEXP log_alpha_prior_sigmasqSEXP, SEXP min_log_alphaSEXP, SEXP kappa_0SEXP, SEXP tolSEXP, SEXP maxitSEXP, SEXP use_priorSEXP) {
+ Rcpp::NumericMatrix y(ySEXP);
+ arma::mat x = Rcpp::as<arma::mat>(xSEXP);
+ int y_n = y.nrow();
+ Rcpp::NumericVector log_alpha(clone(log_alphaSEXP));
+ Rcpp::NumericMatrix mu_hat(mu_hatSEXP);
+ Rcpp::NumericVector log_alpha_prior_mean(log_alpha_prior_meanSEXP);
+ double log_alpha_prior_sigmasq = Rcpp::as<double>(log_alpha_prior_sigmasqSEXP);
+ double min_log_alpha = Rcpp::as<double>(min_log_alphaSEXP);
+ double kappa_0 = Rcpp::as<double>(kappa_0SEXP);
+ int maxit = Rcpp::as<int>(maxitSEXP);
+ double epsilon = 1.0e-4;
+ double a, a_propose, kappa, lp, lpnew, dlp, theta_kappa, theta_hat_kappa, change;
+ // record log posterior values
+ Rcpp::NumericVector initial_lp(y_n);
+ Rcpp::NumericVector initial_dlp(y_n);
+ Rcpp::NumericVector last_lp(y_n);
+ Rcpp::NumericVector last_dlp(y_n);
+ Rcpp::NumericVector last_d2lp(y_n);
+ Rcpp::NumericVector last_change(y_n);
+ Rcpp::IntegerVector iter(y_n);
+ Rcpp::IntegerVector iter_accept(y_n);
+ double tol = Rcpp::as<double>(tolSEXP);
+ bool use_prior = Rcpp::as<bool>(use_priorSEXP);
+
+ for (int i = 0; i < y_n; i++) {
+ Rcpp::checkUserInterrupt();
+ Rcpp::NumericMatrix::Row yrow = y(i,_);
+ Rcpp::NumericMatrix::Row mu_hat_row = mu_hat(i,_);
+ // maximize the log likelihood over the variable a, the log of alpha, the dispersion parameter.
+ // in order to express the optimization in a typical manner,
+ // for calculating theta(kappa) we multiple the log likelihood by -1 and seek a minimum
+ a = log_alpha(i);
+ // we use a line search based on the Armijo rule.
+ // define a function theta(kappa) = f(a + kappa * d), where d is the search direction.
+ // in this case the search direction is taken by the first derivative of the log likelihood
+ lp = log_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ dlp = dlog_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ kappa = kappa_0;
+ initial_lp(i) = lp;
+ initial_dlp(i) = dlp;
+ change = -1.0;
+ last_change(i) = -1.0;
+ for (int t = 0; t < maxit; t++) {
+ // iter counts the number of steps taken out of maxit;
+ iter(i)++;
+ a_propose = a + kappa * dlp;
+ // note: lgamma is unstable for values around 1e17, where there is a switch in lgamma.c
+ // we limit log alpha from going lower than -30
+ if (a_propose < -30.0) {
+ kappa = (-30.0 - a)/dlp;
+ }
+ // note: we limit log alpha from going higher than 10
+ if (a_propose > 10.0) {
+ kappa = (10.0 - a)/dlp;
+ }
+ theta_kappa = -1.0 * log_posterior(a + kappa*dlp, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ theta_hat_kappa = -1.0 * lp - kappa * epsilon * R_pow_di(dlp, 2);
+ // if this inequality is true, we have satisfied the Armijo rule and
+ // accept the step size kappa, otherwise we halve kappa
+ if (theta_kappa <= theta_hat_kappa) {
+ // iter_accept counts the number of accepted proposals;
+ iter_accept(i)++;
+ a = a + kappa * dlp;
+ lpnew = log_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ // look for change in log likelihood
+ change = lpnew - lp;
+ if (change < tol) {
+ lp = lpnew;
+ break;
+ }
+ // if log(alpha) is going to -infinity
+ // break the loop
+ if (a < min_log_alpha) {
+ break;
+ }
+ lp = lpnew;
+ dlp = dlog_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ // instead of resetting kappa to kappa_0
+ // multiple kappa by 1.1
+ kappa = fmin(kappa * 1.1, kappa_0);
+ // every 5 accepts, halve kappa
+ // to prevent slow convergence
+ // due to overshooting
+ if (iter_accept(i) % 5 == 0) {
+ kappa = kappa / 2.0;
+ }
+ } else {
+ kappa = kappa / 2.0;
+ }
+ }
+ last_lp(i) = lp;
+ last_dlp(i) = dlp;
+ last_d2lp(i) = d2log_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ log_alpha(i) = a;
+ // last change indicates the change for the final iteration
+ last_change(i) = change;
+ }
+
+ return Rcpp::List::create(Rcpp::Named("log_alpha",log_alpha),
+ Rcpp::Named("iter",iter),
+ Rcpp::Named("iter_accept",iter_accept),
+ Rcpp::Named("last_change",last_change),
+ Rcpp::Named("initial_lp",initial_lp),
+ Rcpp::Named("initial_dlp",initial_dlp),
+ Rcpp::Named("last_lp",last_lp),
+ Rcpp::Named("last_dlp",last_dlp),
+ Rcpp::Named("last_d2lp",last_d2lp));
+}
+
+// fit the Negative Binomial GLM.
+// note: the betas are on the natural log scale
+//
+// [[Rcpp::export]]
+Rcpp::List fitBeta(SEXP ySEXP, SEXP xSEXP, SEXP nfSEXP, SEXP alpha_hatSEXP, SEXP contrastSEXP, SEXP beta_matSEXP, SEXP lambdaSEXP, SEXP tolSEXP, SEXP maxitSEXP, SEXP useQRSEXP) {
+ arma::mat y = Rcpp::as<arma::mat>(ySEXP);
+ arma::mat nf = Rcpp::as<arma::mat>(nfSEXP);
+ arma::mat x = Rcpp::as<arma::mat>(xSEXP);
+ int y_n = y.n_rows;
+ int y_m = y.n_cols;
+ int x_p = x.n_cols;
+ arma::vec alpha_hat = Rcpp::as<arma::vec>(alpha_hatSEXP);
+ arma::mat beta_mat = Rcpp::as<arma::mat>(beta_matSEXP);
+ arma::mat beta_var_mat = arma::zeros(beta_mat.n_rows, beta_mat.n_cols);
+ arma::mat contrast_num = arma::zeros(beta_mat.n_rows, 1);
+ arma::mat contrast_denom = arma::zeros(beta_mat.n_rows, 1);
+ arma::mat hat_matrix = arma::zeros(x.n_rows, x.n_rows);
+ arma::mat hat_diagonals = arma::zeros(y.n_rows, y.n_cols);
+ arma::colvec lambda = Rcpp::as<arma::colvec>(lambdaSEXP);
+ arma::colvec contrast = Rcpp::as<arma::colvec>(contrastSEXP);
+ int maxit = Rcpp::as<int>(maxitSEXP);
+ arma::colvec yrow, nfrow, beta_hat, mu_hat, z;
+ arma::mat w, ridge, sigma;
+ // vars for QR
+ bool useQR = Rcpp::as<bool>(useQRSEXP);
+ arma::colvec gamma_hat, big_z;
+ arma::vec big_w_diag;
+ arma::mat weighted_x_ridge, q, r, big_w;
+ // deviance, convergence and tolerance
+ double dev, dev_old, conv_test;
+ double tol = Rcpp::as<double>(tolSEXP);
+ double large = 30.0;
+ Rcpp::NumericVector iter(y_n);
+ Rcpp::NumericVector deviance(y_n);
+ // bound the estimated count, as weights include 1/mu
+ double minmu = 0.1;
+ for (int i = 0; i < y_n; i++) {
+ Rcpp::checkUserInterrupt();
+ nfrow = nf.row(i).t();
+ yrow = y.row(i).t();
+ beta_hat = beta_mat.row(i).t();
+ mu_hat = nfrow % exp(x * beta_hat);
+ for (int j = 0; j < y_m; j++) {
+ mu_hat(j) = fmax(mu_hat(j), minmu);
+ }
+ ridge = diagmat(lambda);
+ dev = 0.0;
+ dev_old = 0.0;
+ if (useQR) {
+ // make an orthonormal design matrix including
+ // the ridge penalty
+ for (int t = 0; t < maxit; t++) {
+ iter(i)++;
+ w = diagmat(mu_hat/(1.0 + alpha_hat[i] * mu_hat));
+ // prepare matrices
+ weighted_x_ridge = join_cols(sqrt(w) * x, sqrt(ridge));
+ qr(q, r, weighted_x_ridge);
+ big_w_diag = arma::ones(y_m + x_p);
+ big_w_diag(arma::span(0, y_m - 1)) = diagvec(w);
+ big_w = diagmat(big_w_diag);
+ big_z = arma::zeros(y_m + x_p);
+ z = arma::log(mu_hat / nfrow) + (yrow - mu_hat) / mu_hat;
+ big_z(arma::span(0,y_m - 1)) = z;
+ // IRLS with Q matrix for X
+ gamma_hat = q.t() * sqrt(big_w) * big_z;
+ solve(beta_hat, r, gamma_hat);
+ if (sum(abs(beta_hat) > large) > 0) {
+ iter(i) = maxit;
+ break;
+ }
+ mu_hat = nfrow % exp(x * beta_hat);
+ for (int j = 0; j < y_m; j++) {
+ mu_hat(j) = fmax(mu_hat(j), minmu);
+ }
+ dev = 0.0;
+ for (int j = 0; j < y_m; j++) {
+ // note the order for Rf_dnbinom_mu: x, sz, mu, lg
+ dev = dev + -2.0 * Rf_dnbinom_mu(yrow[j], 1.0/alpha_hat[i], mu_hat[j], 1);
+ }
+ conv_test = fabs(dev - dev_old)/(fabs(dev) + 0.1);
+ if (std::isnan(conv_test)) {
+ iter(i) = maxit;
+ break;
+ }
+ if ((t > 0) & (conv_test < tol)) {
+ break;
+ }
+ dev_old = dev;
+ }
+ } else {
+ // use the standard design matrix x
+ // and matrix inversion
+ for (int t = 0; t < maxit; t++) {
+ iter(i)++;
+ w = diagmat(mu_hat/(1.0 + alpha_hat[i] * mu_hat));
+ z = arma::log(mu_hat / nfrow) + (yrow - mu_hat) / mu_hat;
+ solve(beta_hat, x.t() * w * x + ridge, x.t() * w * z);
+ if (sum(abs(beta_hat) > large) > 0) {
+ iter(i) = maxit;
+ break;
+ }
+ mu_hat = nfrow % exp(x * beta_hat);
+ for (int j = 0; j < y_m; j++) {
+ mu_hat(j) = fmax(mu_hat(j), minmu);
+ }
+ dev = 0.0;
+ for (int j = 0; j < y_m; j++) {
+ // note the order for Rf_dnbinom_mu: x, sz, mu, lg
+ dev = dev + -2.0 * Rf_dnbinom_mu(yrow[j], 1.0/alpha_hat[i], mu_hat[j], 1);
+ }
+ conv_test = fabs(dev - dev_old)/(fabs(dev) + 0.1);
+ if (std::isnan(conv_test)) {
+ iter(i) = maxit;
+ break;
+ }
+ if ((t > 0) & (conv_test < tol)) {
+ break;
+ }
+ dev_old = dev;
+ }
+ }
+ deviance(i) = dev;
+ beta_mat.row(i) = beta_hat.t();
+ // recalculate w so that this is identical if we start with beta_hat
+ w = diagmat(mu_hat/(1.0 + alpha_hat[i] * mu_hat));
+ hat_matrix = sqrt(w) * x * (x.t() * w * x + ridge).i(true) * x.t() * sqrt(w);
+ hat_diagonals.row(i) = diagvec(hat_matrix).t();
+ // sigma is the covariance matrix for the betas
+ sigma = (x.t() * w * x + ridge).i(true) * x.t() * w * x * (x.t() * w * x + ridge).i(true);
+ contrast_num.row(i) = contrast.t() * beta_hat;
+ contrast_denom.row(i) = sqrt(contrast.t() * sigma * contrast);
+ beta_var_mat.row(i) = diagvec(sigma).t();
+ }
+
+ return Rcpp::List::create(Rcpp::Named("beta_mat",beta_mat),
+ Rcpp::Named("beta_var_mat",beta_var_mat),
+ Rcpp::Named("iter",iter),
+ Rcpp::Named("hat_diagonals",hat_diagonals),
+ Rcpp::Named("contrast_num",contrast_num),
+ Rcpp::Named("contrast_denom",contrast_denom),
+ Rcpp::Named("deviance",deviance));
+}
+
+
+// [[Rcpp::export]]
+Rcpp::List fitDispGrid(SEXP ySEXP, SEXP xSEXP, SEXP mu_hatSEXP, SEXP disp_gridSEXP, SEXP log_alpha_prior_meanSEXP, SEXP log_alpha_prior_sigmasqSEXP, SEXP use_priorSEXP) {
+ Rcpp::NumericMatrix y(ySEXP);
+ arma::mat x = Rcpp::as<arma::mat>(xSEXP);
+ int y_n = y.nrow();
+ Rcpp::NumericMatrix mu_hat(mu_hatSEXP);
+ arma::vec disp_grid = Rcpp::as<arma::vec>(disp_gridSEXP);
+ int disp_grid_n = disp_grid.n_elem;
+ Rcpp::NumericVector log_alpha_prior_mean(log_alpha_prior_meanSEXP);
+ double log_alpha_prior_sigmasq = Rcpp::as<double>(log_alpha_prior_sigmasqSEXP);
+ bool use_prior = Rcpp::as<bool>(use_priorSEXP);
+ double a;
+ double delta = disp_grid(1) - disp_grid(0);
+ double a_hat;
+ arma::vec disp_grid_fine;
+ arma::vec logpostvec = arma::zeros(disp_grid.n_elem);
+ arma::vec log_alpha = arma::zeros(y_n);
+ arma::uword idxmax;
+ for (int i = 0; i < y_n; i++) {
+ Rcpp::checkUserInterrupt();
+ Rcpp::NumericMatrix::Row yrow = y(i,_);
+ Rcpp::NumericMatrix::Row mu_hat_row = mu_hat(i,_);
+ for (int t = 0; t < disp_grid_n; t++) {
+ // maximize the log likelihood over the variable a, the log of alpha, the dispersion parameter
+ a = disp_grid(t);
+ logpostvec(t) = log_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ }
+ logpostvec.max(idxmax);
+ a_hat = disp_grid(idxmax);
+ disp_grid_fine = arma::linspace<arma::vec>(a_hat - delta, a_hat + delta, disp_grid_n);
+ for (int t = 0; t < disp_grid_n; t++) {
+ a = disp_grid_fine(t);
+ logpostvec(t) = log_posterior(a, yrow, mu_hat_row, x, log_alpha_prior_mean(i), log_alpha_prior_sigmasq, use_prior);
+ }
+ logpostvec.max(idxmax);
+ log_alpha(i) = disp_grid_fine(idxmax);
+ }
+
+ return Rcpp::List::create(Rcpp::Named("log_alpha",log_alpha));
+}
+
diff --git a/src/Makevars b/src/Makevars
new file mode 100644
index 0000000..22ebc63
--- /dev/null
+++ b/src/Makevars
@@ -0,0 +1 @@
+PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
diff --git a/src/Makevars.win b/src/Makevars.win
new file mode 100644
index 0000000..9542baf
--- /dev/null
+++ b/src/Makevars.win
@@ -0,0 +1,2 @@
+
+PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..8a484cf
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,66 @@
+// This file was generated by Rcpp::compileAttributes
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <RcppArmadillo.h>
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// fitDisp
+Rcpp::List fitDisp(SEXP ySEXP, SEXP xSEXP, SEXP mu_hatSEXP, SEXP log_alphaSEXP, SEXP log_alpha_prior_meanSEXP, SEXP log_alpha_prior_sigmasqSEXP, SEXP min_log_alphaSEXP, SEXP kappa_0SEXP, SEXP tolSEXP, SEXP maxitSEXP, SEXP use_priorSEXP);
+RcppExport SEXP DESeq2_fitDisp(SEXP ySEXPSEXP, SEXP xSEXPSEXP, SEXP mu_hatSEXPSEXP, SEXP log_alphaSEXPSEXP, SEXP log_alpha_prior_meanSEXPSEXP, SEXP log_alpha_prior_sigmasqSEXPSEXP, SEXP min_log_alphaSEXPSEXP, SEXP kappa_0SEXPSEXP, SEXP tolSEXPSEXP, SEXP maxitSEXPSEXP, SEXP use_priorSEXPSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject __result;
+ Rcpp::RNGScope __rngScope;
+ Rcpp::traits::input_parameter< SEXP >::type ySEXP(ySEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type xSEXP(xSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type mu_hatSEXP(mu_hatSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type log_alphaSEXP(log_alphaSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type log_alpha_prior_meanSEXP(log_alpha_prior_meanSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type log_alpha_prior_sigmasqSEXP(log_alpha_prior_sigmasqSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type min_log_alphaSEXP(min_log_alphaSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type kappa_0SEXP(kappa_0SEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type tolSEXP(tolSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type maxitSEXP(maxitSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type use_priorSEXP(use_priorSEXPSEXP);
+ __result = Rcpp::wrap(fitDisp(ySEXP, xSEXP, mu_hatSEXP, log_alphaSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, min_log_alphaSEXP, kappa_0SEXP, tolSEXP, maxitSEXP, use_priorSEXP));
+ return __result;
+END_RCPP
+}
+// fitBeta
+Rcpp::List fitBeta(SEXP ySEXP, SEXP xSEXP, SEXP nfSEXP, SEXP alpha_hatSEXP, SEXP contrastSEXP, SEXP beta_matSEXP, SEXP lambdaSEXP, SEXP tolSEXP, SEXP maxitSEXP, SEXP useQRSEXP);
+RcppExport SEXP DESeq2_fitBeta(SEXP ySEXPSEXP, SEXP xSEXPSEXP, SEXP nfSEXPSEXP, SEXP alpha_hatSEXPSEXP, SEXP contrastSEXPSEXP, SEXP beta_matSEXPSEXP, SEXP lambdaSEXPSEXP, SEXP tolSEXPSEXP, SEXP maxitSEXPSEXP, SEXP useQRSEXPSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject __result;
+ Rcpp::RNGScope __rngScope;
+ Rcpp::traits::input_parameter< SEXP >::type ySEXP(ySEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type xSEXP(xSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type nfSEXP(nfSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type alpha_hatSEXP(alpha_hatSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type contrastSEXP(contrastSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type beta_matSEXP(beta_matSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type lambdaSEXP(lambdaSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type tolSEXP(tolSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type maxitSEXP(maxitSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type useQRSEXP(useQRSEXPSEXP);
+ __result = Rcpp::wrap(fitBeta(ySEXP, xSEXP, nfSEXP, alpha_hatSEXP, contrastSEXP, beta_matSEXP, lambdaSEXP, tolSEXP, maxitSEXP, useQRSEXP));
+ return __result;
+END_RCPP
+}
+// fitDispGrid
+Rcpp::List fitDispGrid(SEXP ySEXP, SEXP xSEXP, SEXP mu_hatSEXP, SEXP disp_gridSEXP, SEXP log_alpha_prior_meanSEXP, SEXP log_alpha_prior_sigmasqSEXP, SEXP use_priorSEXP);
+RcppExport SEXP DESeq2_fitDispGrid(SEXP ySEXPSEXP, SEXP xSEXPSEXP, SEXP mu_hatSEXPSEXP, SEXP disp_gridSEXPSEXP, SEXP log_alpha_prior_meanSEXPSEXP, SEXP log_alpha_prior_sigmasqSEXPSEXP, SEXP use_priorSEXPSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject __result;
+ Rcpp::RNGScope __rngScope;
+ Rcpp::traits::input_parameter< SEXP >::type ySEXP(ySEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type xSEXP(xSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type mu_hatSEXP(mu_hatSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type disp_gridSEXP(disp_gridSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type log_alpha_prior_meanSEXP(log_alpha_prior_meanSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type log_alpha_prior_sigmasqSEXP(log_alpha_prior_sigmasqSEXPSEXP);
+ Rcpp::traits::input_parameter< SEXP >::type use_priorSEXP(use_priorSEXPSEXP);
+ __result = Rcpp::wrap(fitDispGrid(ySEXP, xSEXP, mu_hatSEXP, disp_gridSEXP, log_alpha_prior_meanSEXP, log_alpha_prior_sigmasqSEXP, use_priorSEXP));
+ return __result;
+END_RCPP
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..38d1d64
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,3 @@
+library("testthat")
+library("DESeq2")
+test_check("DESeq2")
diff --git a/tests/testthat/test_1vs1.R b/tests/testthat/test_1vs1.R
new file mode 100644
index 0000000..15d8653
--- /dev/null
+++ b/tests/testthat/test_1vs1.R
@@ -0,0 +1,3 @@
+dds <- makeExampleDESeqDataSet(n=100, m=2)
+expect_warning({ dds <- DESeq(dds)})
+res <- results(dds)
diff --git a/tests/testthat/test_DESeq.R b/tests/testthat/test_DESeq.R
new file mode 100644
index 0000000..36bb83f
--- /dev/null
+++ b/tests/testthat/test_DESeq.R
@@ -0,0 +1,17 @@
+dds <- makeExampleDESeqDataSet(n=100, m=8)
+expect_error(DESeq(dds, test="LRT"))
+expect_error(DESeq(dds, test="Wald", full=~condition, reduced=~1))
+expect_error(DESeq(dds, full=~1))
+
+m <- model.matrix(~ condition, colData(dds))
+expect_error(DESeq(dds, test="LRT", full=m, reduced=~1))
+expect_error(DESeq(dds, test="LRT", full=m, reduced=m))
+expect_error(DESeq(dds, full=m, betaPrior=TRUE))
+
+design(dds) <- ~ 0 + condition
+expect_error(DESeq(dds, betaPrior=TRUE))
+
+dds <- makeExampleDESeqDataSet(n=100)
+dds$condition <- factor(rep(c("A","B","C"),each=4))
+dds <- dds[,1:8]
+expect_error(DESeq(dds))
diff --git a/tests/testthat/test_LRT.R b/tests/testthat/test_LRT.R
new file mode 100644
index 0000000..a10e8fe
--- /dev/null
+++ b/tests/testthat/test_LRT.R
@@ -0,0 +1,8 @@
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+dds$group <- factor(c(1,2,1,2))
+design(dds) <- ~ condition
+expect_error(DESeq(dds, test="LRT", reduced=~group))
+expect_error(DESeq(dds, test="LRT", reduced=~1, modelMatrixType="expanded"))
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+expect_error(nbinomLRT(dds))
diff --git a/tests/testthat/test_LRT_prior.R b/tests/testthat/test_LRT_prior.R
new file mode 100644
index 0000000..56c623c
--- /dev/null
+++ b/tests/testthat/test_LRT_prior.R
@@ -0,0 +1,13 @@
+dds <- makeExampleDESeqDataSet(n=100)
+colData(dds)$condition <- factor(rep(1:3,each=4))
+colData(dds)$group <- factor(rep(1:2,6))
+design(dds) <- ~ group + condition
+dds <- DESeq(dds,test="LRT",reduced=~ group,betaPrior=TRUE)
+expect_true(any(attr(dds,"betaPriorVar") < 1e6))
+res <- results(dds)
+expect_true(grepl("LRT",mcols(res)$description[colnames(res) == "stat"]))
+
+design(dds) <- ~ group * condition
+expect_error(dds <- DESeq(dds,test="LRT",reduced=~ group,betaPrior=TRUE))
+
+
diff --git a/tests/testthat/test_QR.R b/tests/testthat/test_QR.R
new file mode 100644
index 0000000..6255184
--- /dev/null
+++ b/tests/testthat/test_QR.R
@@ -0,0 +1,8 @@
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100,betaSD=1)
+dds <- DESeq(dds)
+ddsNoQR <- nbinomWaldTest(dds,useQR=FALSE)
+res <- results(dds)
+resNoQR <- results(ddsNoQR)
+expect_equal(res$log2FoldChange, resNoQR$log2FoldChange, tolerance=1e-6)
+
diff --git a/tests/testthat/test_addMLE.R b/tests/testthat/test_addMLE.R
new file mode 100644
index 0000000..c09ee64
--- /dev/null
+++ b/tests/testthat/test_addMLE.R
@@ -0,0 +1,18 @@
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=200,m=12,betaSD=1)
+dds$condition <- factor(rep(letters[1:3],each=4))
+dds <- DESeq(dds)
+ddsNP <- nbinomWaldTest(dds, betaPrior=FALSE)
+
+res1 <- results(dds, contrast=c("condition","c","a"), addMLE=TRUE)
+res2 <- results(ddsNP, contrast=c("condition","c","a"))
+expect_equal(res1$lfcMLE, res2$log2FoldChange)
+
+res1 <- results(dds, contrast=c("condition","a","b"), addMLE=TRUE)
+res2 <- results(ddsNP, contrast=c("condition","a","b"))
+expect_equal(res1$lfcMLE, res2$log2FoldChange)
+
+res1 <- results(dds, contrast=c("condition","c","b"), addMLE=TRUE)
+res2 <- results(ddsNP, contrast=c("condition","c","b"))
+expect_equal(res1$lfcMLE, res2$log2FoldChange)
+
diff --git a/tests/testthat/test_betaFitting.R b/tests/testthat/test_betaFitting.R
new file mode 100644
index 0000000..1575cbe
--- /dev/null
+++ b/tests/testthat/test_betaFitting.R
@@ -0,0 +1,44 @@
+# test for equivalence of DESeq2 estimates with those
+# found using IRLS code and using optim
+m <- 10
+set.seed(1)
+y <- rpois(m,20)
+sf <- rep(1,m)
+condition <- factor(rep(0:1,each=m/2))
+x <- cbind(rep(1,m),rep(0:1,each=m/2))
+lambda <- 2
+alpha <- .5
+
+dds <- DESeqDataSetFromMatrix(matrix(y,nrow=1),
+ colData=DataFrame(condition),
+ design= ~ condition)
+sizeFactors(dds) <- sf
+dispersions(dds) <- alpha
+mcols(dds)$baseMean <- mean(y)
+
+# for testing we convert beta to the naturual log scale:
+# convert lambda from log to log2 scale by multiplying by log(2)^2
+# then convert beta back from log2 to log scale by multiplying by log(2)
+betaDESeq <- log(2)*DESeq2:::fitNbinomGLMs(dds, lambda=c(0,lambda*log(2)^2))$betaMatrix
+
+# the IRLS algorithm
+betaIRLS <- c(1,1)
+for (t in 1:100) {
+ mu.hat <- as.vector(sf * exp(x %*% betaIRLS))
+ w <- diag(1/(1/mu.hat^2 * ( mu.hat + alpha * mu.hat^2 )))
+ z <- log(mu.hat/sf) + (y - mu.hat)/mu.hat
+ ridge <- diag(c(0,lambda))
+ betaIRLS <- as.vector(solve(t(x) %*% w %*% x + ridge) %*% t(x) %*% w %*% z)
+}
+
+# using optim
+objectiveFn <- function(p) {
+ mu <- exp(x %*% p)
+ logLike <- sum(dnbinom(y, mu=mu, size=1/alpha, log=TRUE))
+ prior <- dnorm(p[2], 0, sqrt(1/lambda),log=TRUE)
+ -1 * (logLike + prior)
+}
+betaOptim <- optim(c(.1,.1), objectiveFn, control=list(reltol=1e-16))$par
+
+expect_equal(as.numeric(betaDESeq), betaIRLS, tolerance=1e-6)
+expect_equal(as.numeric(betaDESeq), betaOptim, tolerance=1e-6)
diff --git a/tests/testthat/test_collapse.R b/tests/testthat/test_collapse.R
new file mode 100644
index 0000000..d6c0194
--- /dev/null
+++ b/tests/testthat/test_collapse.R
@@ -0,0 +1,6 @@
+dds <- makeExampleDESeqDataSet(n=10, m=8)
+dds$sample <- rep(1:4, each=2)
+dds$run <- 1:8
+dds2 <- collapseReplicates(dds, groupby=dds$sample, run=dds$run)
+expect_true(all(counts(dds2)[,1] == rowSums(counts(dds)[,1:2])))
+expect_true(dds2$runsCollapsed[1] == "1,2")
diff --git a/tests/testthat/test_construction_errors.R b/tests/testthat/test_construction_errors.R
new file mode 100644
index 0000000..28bfe2f
--- /dev/null
+++ b/tests/testthat/test_construction_errors.R
@@ -0,0 +1,36 @@
+coldata <- DataFrame(x=factor(c("A","A","B","B")),
+ name=letters[1:4],
+ ident=factor(rep("A",4)),
+ num=1:4,
+ missinglevels=factor(c("A","A","B","B"), levels=c("A","B","C")),
+ notref=factor(c("control","control","abc","abc")),
+ row.names=1:4)
+counts <- matrix(1:16, ncol=4)
+
+expect_message(DESeqDataSet(SummarizedExperiment(list(foo=counts), colData=coldata), ~ x))
+expect_error(DESeqDataSetFromMatrix(matrix(c(1:11,-1),ncol=4), coldata, ~ x))
+expect_error(DESeqDataSetFromMatrix(matrix(c(1:11,0.5),ncol=4), coldata, ~ x))
+expect_error(DESeqDataSetFromMatrix(matrix(rep(0,16),ncol=4), coldata, ~ x))
+expect_warning(DESeqDataSetFromMatrix(matrix(rep(1:4,4),ncol=4), coldata, ~ x))
+expect_warning(DESeqDataSetFromMatrix(matrix(1:16, ncol=4, dimnames=list(c(1,2,3,3),1:4)), coldata, ~ x))
+expect_error(DESeqDataSetFromMatrix(counts, coldata, ~ y))
+expect_warning(DESeqDataSetFromMatrix(counts, coldata, ~ name))
+expect_error(DESeqDataSetFromMatrix(counts, coldata, ~ ident))
+expect_message(DESeqDataSetFromMatrix(counts, coldata, ~ num))
+expect_message(DESeqDataSetFromMatrix(counts, coldata, ~ missinglevels))
+expect_message(DESeqDataSetFromMatrix(counts, coldata, ~ notref))
+
+# same colnames but in different order:
+expect_error(DESeqDataSetFromMatrix(matrix(1:16, ncol=4, dimnames=list(1:4, 4:1)), coldata, ~ x))
+
+# testing incoming metadata columns
+coldata <- DataFrame(x=factor(c("A","A","B","B")))
+rowranges <- GRanges("1", IRanges(1 + 0:3 * 10, width=10))
+se <- SummarizedExperiment(list(counts=counts), colData=coldata, rowRanges=rowranges)
+mcols(colData(se)) <- DataFrame(info="x is a factor")
+mcols(se)$id <- 1:4
+mcols(mcols(se)) <- DataFrame(info="the gene id")
+dds <- DESeqDataSet(se, ~ x)
+mcols(colData(dds))
+mcols(mcols(dds))
+
diff --git a/tests/testthat/test_counts_input.R b/tests/testthat/test_counts_input.R
new file mode 100644
index 0000000..f4b2d17
--- /dev/null
+++ b/tests/testthat/test_counts_input.R
@@ -0,0 +1,14 @@
+# count matrix input
+cnts <- matrix(rnbinom(40,mu=100,size=2),ncol=4)
+colnames(cnts) <- letters[1:4]
+mode(cnts) <- "integer"
+coldata <- data.frame(cond=factor(c("A","A","B","B")))
+dds <- DESeqDataSetFromMatrix(cnts, coldata, ~cond)
+
+# tidy data frame input
+gene.names <- paste0("gene",1:10)
+tidy.counts <- cbind(gene.names, as.data.frame(cnts))
+dds <- DESeqDataSetFromMatrix(tidy.counts, coldata, ~cond, tidy=TRUE)
+expect_true(all(rownames(dds) == gene.names))
+expect_true(all(counts(dds) == cnts))
+
diff --git a/tests/testthat/test_custom_filt.R b/tests/testthat/test_custom_filt.R
new file mode 100644
index 0000000..ed66e7b
--- /dev/null
+++ b/tests/testthat/test_custom_filt.R
@@ -0,0 +1,25 @@
+# try a custom filter function
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=200, m=4, betaSD=rep(c(0,2),c(150,50)))
+dds <- DESeq(dds)
+res <- results(dds)
+
+filter <- mcols(dds)$baseMean
+test <- res$pvalue
+theta <- seq(mean(filter == 0), 1, length=20)
+method <- "BH"
+alpha <- 0.1
+
+customFilt <- function(alpha, filter, test, theta, method) {
+ cutoff <- quantile(filter, theta)
+ numRej <- sapply(cutoff, function(x) sum(p.adjust(test[filter > x]) < alpha, na.rm=TRUE))
+ threshold <- theta[which(numRej == max(numRej))[1]]
+ padj <- numeric(length(test))
+ padj <- NA
+ idx <- filter > quantile(filter, threshold)
+ padj[idx] <- p.adjust(test[idx], method=method)
+ return(padj)
+}
+
+resCustom <- results(dds, filterFun=customFilt)
+#plot(res$padj, resCustom$padj);abline(0,1)
diff --git a/tests/testthat/test_disp_fit.R b/tests/testthat/test_disp_fit.R
new file mode 100644
index 0000000..58340b9
--- /dev/null
+++ b/tests/testthat/test_disp_fit.R
@@ -0,0 +1,113 @@
+# test the optimization of the logarithm of dispersion (alpha)
+# parameter with Cox-Reid adjustment and prior distribution.
+# also test the derivatives of the log posterior w.r.t. log alpha
+m <- 10
+set.seed(1)
+y <- rpois(m,20)
+sf <- rep(1,m)
+condition <- factor(rep(0:1,each=m/2))
+x <- cbind(rep(1,m),rep(0:1,each=m/2))
+colnames(x) <- c("Intercept","condition")
+
+lambda <- 2
+alpha <- .5
+
+# make a DESeqDataSet but don't use the design formula
+# instead we supply a model matrix below
+dds <- DESeqDataSetFromMatrix(matrix(y,nrow=1),
+ colData=DataFrame(condition),
+ design= ~ condition)
+sizeFactors(dds) <- sf
+dispersions(dds) <- alpha
+mcols(dds)$baseMean <- mean(y)
+
+# for testing we convert beta to the naturual log scale:
+# convert lambda from log to log2 scale by multiplying by log(2)^2
+# then convert beta back from log2 to log scale by multiplying by log(2)
+betaDESeq <- log(2)*DESeq2:::fitNbinomGLMs(dds, lambda=c(0,lambda*log(2)^2),
+ modelMatrix=x)$betaMatrix
+
+log_alpha_prior_mean <- .5
+log_alpha_prior_sigmasq <- 1
+mu.hat <- as.numeric(exp(x %*% t(betaDESeq)))
+
+dispRes <- DESeq2:::fitDisp(ySEXP = matrix(y,nrow=1), xSEXP = x,
+ mu_hatSEXP = matrix(mu.hat,nrow=1), log_alphaSEXP = 0,
+ log_alpha_prior_meanSEXP = log_alpha_prior_mean,
+ log_alpha_prior_sigmasqSEXP = log_alpha_prior_sigmasq,
+ min_log_alphaSEXP = log(1e-8), kappa_0SEXP = 1,
+ tolSEXP = 1e-16, maxitSEXP = 100, use_priorSEXP = TRUE)
+
+# maximum a posteriori (MAP) estimate from DESeq
+dispDESeq <- dispRes$log_alpha
+
+# MAP estimate using optim
+logPost <- function(log.alpha) {
+ alpha <- exp(log.alpha)
+ w <- diag(1/(1/mu.hat^2 * ( mu.hat + alpha * mu.hat^2 )))
+ logLike <- sum(dnbinom(y, mu=mu.hat, size=1/alpha, log=TRUE))
+ coxReid <- -.5*(log(det(t(x) %*% w %*% x)))
+ logPrior <- dnorm(log.alpha, log_alpha_prior_mean, sqrt(log_alpha_prior_sigmasq), log=TRUE)
+ (logLike + coxReid + logPrior)
+}
+
+dispOptim <- optim(0, function(p) -1*logPost(p), control=list(reltol=1e-16),
+ method="Brent", lower=-10, upper=10)$par
+
+expect_equal(dispDESeq, dispOptim, tolerance=1e-6)
+
+# check derivatives:
+
+# from Ted Harding https://stat.ethz.ch/pipermail/r-help/2007-September/140013.html
+num.deriv <- function(f,x,h=0.001) (f(x + h/2) - f(x-h/2))/h
+num.2nd.deriv <- function(f,x,h=0.001) (f(x + h) - 2*f(x) + f(x - h))/h^2
+
+# first derivative of log posterior w.r.t log alpha at start
+dispDerivDESeq <- dispRes$initial_dlp
+dispDerivNum <- num.deriv(logPost,0)
+
+expect_equal(dispDerivDESeq, dispDerivNum, tolerance=1e-6)
+
+# second derivative at finish
+dispD2DESeq <- dispRes$last_d2lp
+dispD2Num <- num.2nd.deriv(logPost, dispRes$log_alpha)
+
+expect_equal(dispD2DESeq, dispD2Num, tolerance=1e-6)
+
+
+# test fit alternative
+dds <- makeExampleDESeqDataSet()
+dds <- estimateSizeFactors(dds)
+ddsLocal <- estimateDispersions(dds, fitType="local")
+ddsMean <- estimateDispersions(dds, fitType="mean")
+ddsMed <- estimateDispersionsGeneEst(dds)
+useForMedian <- mcols(ddsMed)$dispGeneEst > 1e-7
+medianDisp <- median(mcols(ddsMed)$dispGeneEst[useForMedian],na.rm=TRUE)
+dispersionFunction(ddsMed) <- function(mu) medianDisp
+ddsMed <- estimateDispersionsMAP(ddsMed)
+
+
+# test iterative
+set.seed(1)
+dds <- makeExampleDESeqDataSet(m=50,n=100,betaSD=1,interceptMean=8)
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersionsGeneEst(dds, niter=5)
+with(mcols(dds)[!mcols(dds)$allZero,],
+ expect_equal(log(trueDisp), log(dispGeneEst),tol=0.2))
+
+
+# test dispersion fitting in R
+set.seed(1)
+trueDisp <- c(.005,.01,.05,.1,.2,.5)
+trueMu <- 1000
+m <- 200
+x <- cbind(rep(1,m),rep(0:1,each=m/2))
+y <- matrix(rnbinom(length(trueDisp)*m, mu=trueMu, size=1/rep(trueDisp,m)),ncol=m)
+mu <- matrix(rep(rowMeans(y),m),ncol=m)
+disp <- DESeq2:::fitDispInR(y = y, x = x, mu = mu,
+ logAlphaPriorMean = NA,
+ logAlphaPriorSigmaSq = NA,
+ usePrior=FALSE)
+# plot(log(trueDisp), log(disp));abline(0,1)
+expect_equal(log(trueDisp), log(disp), tol=.5)
+
diff --git a/tests/testthat/test_dispersions.R b/tests/testthat/test_dispersions.R
new file mode 100644
index 0000000..435d057
--- /dev/null
+++ b/tests/testthat/test_dispersions.R
@@ -0,0 +1,28 @@
+# test disperion errors
+
+dds <- makeExampleDESeqDataSet(n=100, m=2)
+dds <- estimateSizeFactors(dds)
+expect_error(estimateDispersionsGeneEst(dds))
+
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100, m=4, dispMeanRel=function(x) 0.001 + x/1e3, interceptMean=8, interceptSD=2)
+dds <- estimateSizeFactors(dds)
+mcols(dds)$dispGeneEst <- rep(1e-7, 100)
+expect_error(estimateDispersionsFit(dds))
+dds <- estimateDispersionsGeneEst(dds)
+expect_message(estimateDispersionsFit(dds))
+
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+dds <- estimateSizeFactors(dds)
+mcols(dds)$dispGeneEst <- rep(1e-7, 100)
+dispersionFunction(dds) <- function(x) 1e-6
+expect_warning(estimateDispersionsMAP(dds))
+
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+dds <- estimateSizeFactors(dds)
+levels(dds$condition) <- c("A","B","C")
+expect_error(estimateDispersions(dds))
+dds$condition <- droplevels(dds$condition)
+dds$group <- dds$condition
+design(dds) <- ~ group + condition
+expect_error(estimateDispersions(dds))
diff --git a/tests/testthat/test_edge_case.R b/tests/testthat/test_edge_case.R
new file mode 100644
index 0000000..f8c77ea
--- /dev/null
+++ b/tests/testthat/test_edge_case.R
@@ -0,0 +1,46 @@
+# one row
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=1)
+sizeFactors(dds) <- rep(1,ncol(dds))
+dispersions(dds) <- .5
+dds <- nbinomWaldTest(dds)
+res <- results(dds)
+dds <- nbinomLRT(dds, reduced=~1)
+res <- results(dds)
+
+
+# only intercept
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100)
+design(dds) <- ~ 1
+dds <- DESeq(dds)
+res <- results(dds)
+
+
+# metadata insertion
+dds <- makeExampleDESeqDataSet(n=50,m=4)
+
+dds2 <- DESeqDataSetFromMatrix( counts(dds), colData(dds), design(dds) )
+mcols(dds2)$foo <- paste( "bar", 1:nrow(dds2) )
+dds2 <- DESeq(dds2)
+results(dds2)
+expect_true(class(mcols(mcols(dds2))$type) == "character")
+
+dds3 <- DESeqDataSetFromMatrix( counts(dds), DataFrame(row.names=1:ncol(dds)), ~ 1 )
+dds3$test <- 1:ncol(dds3)
+dds3 <- estimateSizeFactors(dds3)
+expect_true(class(mcols(colData(dds3))$type) == "character")
+
+
+# underscores
+dds <- makeExampleDESeqDataSet(n=50,m=4)
+levels(dds$condition) <- c("A_1","B_2")
+dds$exp_cond <- dds$condition
+design(dds) <- ~ exp_cond
+dds <- DESeq(dds)
+results(dds)
+
+# NA in colData
+dds <- makeExampleDESeqDataSet(n=50,m=4)
+colData(dds)$condition[4] <- NA
+expect_error(DESeq(dds))
diff --git a/tests/testthat/test_factors.R b/tests/testthat/test_factors.R
new file mode 100644
index 0000000..c9d2e32
--- /dev/null
+++ b/tests/testthat/test_factors.R
@@ -0,0 +1,9 @@
+dds <- makeExampleDESeqDataSet(n=100, m=6)
+levels(dds$condition) <- c("test-","test+")
+expect_error(DESeq(dds))
+
+dds <- makeExampleDESeqDataSet(n=100, m=6)
+dds$condition <- factor(rep(letters[1:3], each=2), ordered=TRUE)
+expect_error(DESeq(dds))
+mm <- model.matrix(~ condition, data=colData(dds))
+dds <- DESeq(dds, full=mm) # betaPrior=FALSE
diff --git a/tests/testthat/test_fpkm.R b/tests/testthat/test_fpkm.R
new file mode 100644
index 0000000..4e6b5a3
--- /dev/null
+++ b/tests/testthat/test_fpkm.R
@@ -0,0 +1,5 @@
+dds <- DESeqDataSetFromMatrix(matrix(c(1:4,2 * 1:4), ncol=2), DataFrame(x=1:2), ~ 1)
+rowRanges(dds) <- GRanges("1", IRanges(start=0:3 * 10 + 1, width=10))
+expect_equal(fpkm(dds)[1,1], 1e5 * 100, tolerance=.1)
+expect_equal(fpm(dds)[1,1], 1e5, tolerance=.1)
+expect_equal(fpm(dds, robust=FALSE)[1,1], 1e5)
diff --git a/tests/testthat/test_frozen_transform.R b/tests/testthat/test_frozen_transform.R
new file mode 100644
index 0000000..93df7de
--- /dev/null
+++ b/tests/testthat/test_frozen_transform.R
@@ -0,0 +1,27 @@
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100)
+design(dds) <- ~ 1
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+
+expect_warning(ddsNew <- makeExampleDESeqDataSet(m=1,n=100))
+counts(ddsNew)[,1] <- counts(dds)[,1]
+sizeFactors(ddsNew)[1] <- sizeFactors(dds)[1]
+
+# VST
+vsd <- varianceStabilizingTransformation(dds, blind=FALSE)
+dispersionFunction(ddsNew) <- dispersionFunction(dds)
+vsdNew <- varianceStabilizingTransformation(ddsNew, blind=FALSE)
+expect_equal(assay(vsd)[,1],assay(vsdNew)[,1],tolerance=1e-3)
+
+# rlog
+rld <- rlogTransformation(dds, blind=FALSE)
+mcols(ddsNew)$dispFit <- mcols(dds)$dispFit
+betaPriorVar <- attr(rld,"betaPriorVar")
+intercept <- mcols(rld)$rlogIntercept
+rldNew <- rlogTransformation(ddsNew, blind=FALSE,
+ betaPriorVar=betaPriorVar,
+ intercept=intercept)
+expect_equal(assay(rld)[,1],assay(rldNew)[,1],tolerance=1e-3)
+
+
diff --git a/tests/testthat/test_gene_length.R b/tests/testthat/test_gene_length.R
new file mode 100644
index 0000000..479eae9
--- /dev/null
+++ b/tests/testthat/test_gene_length.R
@@ -0,0 +1,29 @@
+n <- 10
+files <- c("sample1","sample2","sample3","sample4")
+
+envir <- environment()
+
+# Cufflinks-like
+gene_id <- rep(paste0("gene",seq_len(n)),each=3)
+set.seed(1)
+sample1 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+sample2 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+sample3 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+sample4 <- data.frame(gene_id=gene_id,length=rpois(3*n,2000),FPKM=round(rnorm(3*n,10,1),2))
+importer <- get
+dds <- makeExampleDESeqDataSet(n=n + 2, m=4)
+dds <- normalizeGeneLength(dds, files=files, level="tx",
+ geneIdCol="gene_id", lengthCol="length", abundanceCol="FPKM",
+ dropGenes=TRUE, importer=importer, envir=envir)
+
+# RSEM-like
+gene_id <- paste0("gene",seq_len(n))
+sample1 <- data.frame(gene_id=gene_id,effective_length=rpois(n,2000))
+sample2 <- data.frame(gene_id=gene_id,effective_length=rpois(n,2000))
+sample3 <- data.frame(gene_id=gene_id,effective_length=rpois(n,2000))
+sample4 <- data.frame(gene_id=gene_id,effective_length=rpois(n,2000))
+dds <- makeExampleDESeqDataSet(n=n + 2, m=4)
+dds <- normalizeGeneLength(dds, files=files, level="gene",
+ geneIdCol="gene_id", lengthCol="effective_length",
+ dropGenes=TRUE, importer=importer, envir=envir)
+
diff --git a/tests/testthat/test_htseq.R b/tests/testthat/test_htseq.R
new file mode 100644
index 0000000..12fab65
--- /dev/null
+++ b/tests/testthat/test_htseq.R
@@ -0,0 +1,7 @@
+dir <- system.file(package="pasilla", "extdata")
+files <- grep("treated",list.files(dir),value=TRUE)
+sampleTable <- data.frame(id=seq_along(files), files,
+ condition=factor(rep(c("t","u"),c(3,4))))
+setwd(dir)
+expect_error(DESeqDataSetFromHTSeqCount(sampleTable))
+dds <- DESeqDataSetFromHTSeqCount(sampleTable, design=~condition)
diff --git a/tests/testthat/test_interactions.R b/tests/testthat/test_interactions.R
new file mode 100644
index 0000000..909907f
--- /dev/null
+++ b/tests/testthat/test_interactions.R
@@ -0,0 +1,8 @@
+dds <- makeExampleDESeqDataSet(n=100,m=8)
+colData(dds)$group <- factor(rep(c("X","Y"),times=ncol(dds)/2))
+design(dds) <- ~ condition + group + condition:group
+dds <- DESeq(dds)
+expect_equal(resultsNames(dds)[4], "conditionB.groupY")
+# interactions error
+expect_error(DESeq(dds, betaPrior=TRUE))
+
diff --git a/tests/testthat/test_methods.R b/tests/testthat/test_methods.R
new file mode 100644
index 0000000..d261e11
--- /dev/null
+++ b/tests/testthat/test_methods.R
@@ -0,0 +1,8 @@
+coldata <- DataFrame(x=factor(c("A","A","B","B")))
+counts <- matrix(1:16, ncol=4)
+dds <- DESeqDataSetFromMatrix(counts, coldata, ~ x)
+expect_warning(counts(dds, replace=TRUE))
+expect_error(counts(dds, normalized=TRUE))
+expect_error(sizeFactors(dds) <- c(-1, -1, -1, -1))
+expect_error(normalizationFactors(dds) <- matrix(-1, ncol=4, nrow=4))
+expect_error(estimateDispersions(dds))
diff --git a/tests/testthat/test_model_matrix.R b/tests/testthat/test_model_matrix.R
new file mode 100644
index 0000000..4b49ddc
--- /dev/null
+++ b/tests/testthat/test_model_matrix.R
@@ -0,0 +1,18 @@
+dds <- makeExampleDESeqDataSet(n=100, m=18)
+dds$group <- factor(rep(1:3,each=6))
+dds$condition <- factor(rep(rep(c("A","B","C"),each=2),3))
+# note: design is not used
+design(dds) <- ~ 1
+dds <- dds[,-c(17,18)]
+
+m1 <- model.matrix(~ group*condition, colData(dds))
+m1 <- m1[,-9]
+m0 <- model.matrix(~ group + condition, colData(dds))
+
+dds <- DESeq(dds, full=m1, reduced=m0, test="LRT")
+results(dds)[1,]
+results(dds, name="group2.conditionC", test="Wald")[1,]
+dds <- removeResults(dds)
+dds <- DESeq(dds, full=m1, test="Wald", betaPrior=FALSE)
+results(dds)[1,]
+
diff --git a/tests/testthat/test_nbinomWald.R b/tests/testthat/test_nbinomWald.R
new file mode 100644
index 0000000..3385a12
--- /dev/null
+++ b/tests/testthat/test_nbinomWald.R
@@ -0,0 +1,15 @@
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+expect_error(nbinomWaldTest(dds))
+expect_error(nbinomLRT(dds))
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+mm <- model.matrix(~ condition, colData(dds))
+mm0 <- model.matrix(~ 1, colData(dds))
+expect_error(nbinomWaldTest(dds, betaPrior=TRUE, modelMatrix=mm))
+expect_error(nbinomLRT(dds, betaPrior=TRUE, full=mm, reduced=mm0))
+expect_error(nbinomWaldTest(dds, betaPrior=FALSE, modelMatrixType="expanded"))
+expect_error(nbinomLRT(dds, betaPrior=FALSE, modelMatrixType="expanded"))
+dds2 <- estimateMLEForBetaPriorVar(dds)
+estimateBetaPriorVar(dds2, betaPriorMethod="quantile")
+dds <- nbinomWaldTest(dds, modelMatrixType="standard")
+covarianceMatrix(dds, 1)
diff --git a/tests/testthat/test_optim.R b/tests/testthat/test_optim.R
new file mode 100644
index 0000000..b5d1ff8
--- /dev/null
+++ b/tests/testthat/test_optim.R
@@ -0,0 +1,34 @@
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100)
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+# make a large predictor to test scaling
+colData(dds)$condition <- rnorm(ncol(dds),0,1000)
+modelMatrix <- model.matrix(~ condition, as.data.frame(colData(dds)))
+fit <- DESeq2:::fitNbinomGLMs(dds, modelMatrix=modelMatrix,
+ modelFormula = ~ condition,
+ alpha_hat = dispersions(dds),
+ lambda = c(2,2),
+ renameCols=TRUE, betaTol=1e-8,
+ maxit=100, useOptim=TRUE,
+ useQR=TRUE, forceOptim=FALSE)
+fitOptim <- DESeq2:::fitNbinomGLMs(dds, modelMatrix=modelMatrix,
+ modelFormula = ~ condition,
+ alpha_hat = dispersions(dds),
+ lambda = c(2,2),
+ renameCols=TRUE, betaTol=1e-8,
+ maxit=100, useOptim=TRUE,
+ useQR=TRUE, forceOptim=TRUE)
+expect_equal(fit$betaMatrix, fitOptim$betaMatrix,tolerance=1e-6)
+expect_equal(fit$betaSE, fitOptim$betaSE,tolerance=1e-6)
+
+# test optim gives same lfcSE
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100, m=10)
+counts(dds)[1,] <- c(rep(0L,5),c(1000L,1000L,0L,0L,0L))
+dds <- DESeq(dds, betaPrior=FALSE)
+res1 <- results(dds, contrast=c("condition","B","A"))
+res2 <- results(dds, contrast=c(0,1))
+expect_true(all.equal(res1$lfcSE, res2$lfcSE))
+expect_true(all.equal(res1$pvalue, res2$pvalue))
+
diff --git a/tests/testthat/test_outlier.R b/tests/testthat/test_outlier.R
new file mode 100644
index 0000000..66d86a6
--- /dev/null
+++ b/tests/testthat/test_outlier.R
@@ -0,0 +1,65 @@
+# test filtering and replacement
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100, m=12, dispMeanRel = function(x) 4/x + .5)
+counts(dds)[1,] <- rep(0L, 12)
+counts(dds)[2,] <- c(100000L, rep(10L, 11))
+counts(dds)[3,] <- c(100000L, rep(0L, 11))
+dds0 <- DESeq(dds, minReplicatesForReplace=Inf)
+dds1 <- DESeq(dds, minReplicatesForReplace=6)
+pval0 <- results(dds0)[1:3,"pvalue"]
+pval <- results(dds1)[1:3,"pvalue"]
+LFC0 <- results(dds0)[1:3,"log2FoldChange"]
+LFC <- results(dds1)[1:3,"log2FoldChange"]
+
+# filtered
+expect_true(all(is.na(pval0)))
+# not filtered
+expect_true(all(!is.na(pval[2:3])))
+# counts still the same
+expect_true(all(counts(dds1)==counts(dds)))
+# first is NA
+expect_true(is.na(LFC[1]))
+# replaced, reduced LFC
+expect_true(abs(LFC[2]) < abs(LFC0[2]))
+# replaced, LFC now zero
+expect_true(LFC[3] == 0)
+idx <- which(!mcols(dds1)$replace)
+# the pvalue for those not replaced is equal
+expect_equal(results(dds1)$pvalue[idx], results(dds0)$pvalue[idx])
+
+
+# check that outlier filtering catches throughout range of mu
+beta0 <- seq(from=1,to=16,length=100)
+idx <- rep(rep(c(TRUE,FALSE),c(1,9)),10)
+set.seed(1)
+#par(mfrow=c(2,3))
+for (disp0 in c(.01,.5)) {
+ for (m in c(10,20,80)) {
+ dds <- makeExampleDESeqDataSet(n=100, m=m, interceptMean=beta0, interceptSD=0,
+ dispMeanRel=function(x) 4/x + disp0)
+ counts(dds)[idx,1] <- as.integer(1000 * 2^beta0[idx])
+ dds <- DESeq(dds, minReplicatesForReplace=Inf, quiet=TRUE)
+ res <- results(dds)
+ cutoff <- qf(.99, 2, m-2)
+ outlierCooks <- assays(dds)[["cooks"]][idx,1] > cutoff
+ maxOtherCooks <- apply(assays(dds)[["cooks"]][idx,-1], 1, max) < cutoff
+ expect_true(all(is.na(res$pvalue[idx])))
+ expect_true(all(outlierCooks))
+ expect_true(all(maxOtherCooks))
+ #col <- rep("black", 100)
+ #col[idx] <- ifelse(outlierCooks, ifelse(maxOtherCooks, "blue", "red"), "purple")
+ #plot(assays(dds)[["cooks"]][,1], col=col, log="y",
+ # main=paste(m,"-",disp0), ylab="cooks");abline(h=qf(.99,2,m-2))
+ }
+}
+
+dds <- makeExampleDESeqDataSet(n=100)
+counts(dds)[1,1] <- 1000000L
+dds <- DESeq(dds, test="LRT", reduced=~1, minReplicatesForReplace=6)
+dds <- DESeq(dds, test="LRT", reduced=~1, betaPrior=TRUE, minReplicatesForReplace=6)
+
+# test replace function
+dds <- makeExampleDESeqDataSet(n=100,m=4)
+expect_error(replaceOutliers(dds))
+dds <- DESeq(dds)
+expect_error(replaceOutliers(dds, minReplicates=2))
diff --git a/tests/testthat/test_parallel.R b/tests/testthat/test_parallel.R
new file mode 100644
index 0000000..08bb74f
--- /dev/null
+++ b/tests/testthat/test_parallel.R
@@ -0,0 +1,64 @@
+dispMeanRel <- function(x) (4/x + .1) * exp(rnorm(length(x),0,sqrt(.5)))
+set.seed(1)
+dds0 <- makeExampleDESeqDataSet(n=100,dispMeanRel=dispMeanRel)
+counts(dds0)[51:60,] <- 0L
+
+# the following is an example of a simple parallelizable DESeq() run
+# without outlier replacement. see DESeq2:::DESeqParallel for the code
+# which is actually used in DESeq()
+
+nworkers <- 3
+idx <- factor(sort(rep(seq_len(nworkers),length=nrow(dds0))))
+
+### BEGINNING ###
+
+dds <- estimateSizeFactors(dds0)
+dds <- do.call(rbind, lapply(levels(idx), function(l) {
+ estimateDispersionsGeneEst(dds[idx == l,,drop=FALSE])
+}))
+dds <- estimateDispersionsFit(dds)
+dispPriorVar <- estimateDispersionsPriorVar(dds)
+dds <- do.call(rbind, lapply(levels(idx), function(l) {
+ ddsSub <- estimateDispersionsMAP(dds[idx == l,,drop=FALSE], dispPriorVar=dispPriorVar)
+ estimateMLEForBetaPriorVar(ddsSub)
+}))
+betaPriorVar <- estimateBetaPriorVar(dds)
+dds <- do.call(rbind, lapply(levels(idx), function(l) {
+ nbinomWaldTest(dds[idx == l,,drop=FALSE], betaPriorVar=betaPriorVar)
+}))
+
+### END ###
+
+res1 <- results(dds)
+
+dds2 <- DESeq(dds0)
+res2 <- results(dds2)
+
+expect_equal(mcols(dds)$dispGeneEst, mcols(dds2)$dispGeneEst)
+expect_equal(mcols(dds)$dispFit, mcols(dds2)$dispFit)
+expect_equal(mcols(dds)$dispMAP, mcols(dds2)$dispMAP)
+expect_equal(mcols(dds)$dispersion, mcols(dds2)$dispersion)
+expect_equal(attr(dispersionFunction(dds), "dispPriorVar"),
+ attr(dispersionFunction(dds2), "dispPriorVar"))
+expect_equal(attr(dispersionFunction(dds), "varLogDispEsts"),
+ attr(dispersionFunction(dds2), "varLogDispEsts"))
+expect_equal(mcols(dds)$MLE_condition_B_vs_A,
+ mcols(dds2)$MLE_condition_B_vs_A)
+expect_equal(attr(dds, "betaPriorVar"),
+ attr(dds2, "betaPriorVar"))
+expect_equal(mcols(dds)$conditionB, mcols(dds2)$conditionB)
+expect_equal(res1$log2FoldChange, res2$log2FoldChange)
+expect_equal(res1$pvalue, res2$pvalue)
+
+library("BiocParallel")
+register(SerialParam())
+dds3 <- DESeq(dds0, parallel=TRUE)
+res3 <- results(dds3, parallel=TRUE)
+res4 <- results(dds3)
+expect_equal(res2$pvalue, res3$pvalue)
+expect_equal(res3$pvalue, res4$pvalue)
+
+dds <- makeExampleDESeqDataSet(n=100,m=8)
+dds <- DESeq(dds, parallel=TRUE, test="LRT", reduced=~1)
+dds <- DESeq(dds, parallel=TRUE, test="LRT", reduced=~1, betaPrior=TRUE)
+dds <- DESeq(dds, parallel=TRUE, betaPrior=FALSE)
diff --git a/tests/testthat/test_plots.R b/tests/testthat/test_plots.R
new file mode 100644
index 0000000..4b92d70
--- /dev/null
+++ b/tests/testthat/test_plots.R
@@ -0,0 +1,25 @@
+# test plots
+dds <- makeExampleDESeqDataSet(n=100,m=8)
+dds$group <- factor(rep(c(1,2,1,2),each=2))
+dds <- DESeq(dds)
+res <- results(dds)
+plotDispEsts(dds)
+plotMA(dds)
+plotMA(dds, ylim=c(-1,1))
+plotCounts(dds, 1)
+plotCounts(dds, 1, intgroup=c("condition","group"))
+plotCounts(dds, 1, transform=TRUE)
+expect_error(plotCounts(dds, 1, intgroup="foo"))
+vsd <- varianceStabilizingTransformation(dds, blind=FALSE)
+plotPCA(vsd)
+dat <- plotPCA(vsd, returnData=TRUE)
+plotPCA(vsd, intgroup=c("condition","group"))
+expect_error(plotPCA(vsd, intgroup="foo"))
+plotSparsity(dds)
+
+# plotMA MLE
+res <- results(dds)
+expect_error(plotMA(res, MLE=TRUE))
+res <- results(dds, addMLE=TRUE)
+plotMA(res, MLE=TRUE)
+dev.off()
diff --git a/tests/testthat/test_results.R b/tests/testthat/test_results.R
new file mode 100644
index 0000000..93f18e7
--- /dev/null
+++ b/tests/testthat/test_results.R
@@ -0,0 +1,153 @@
+## test contrasts
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=200,m=12)
+dds$condition <- factor(rep(1:3,each=4))
+dds$group <- factor(rep(1:2,length=ncol(dds)))
+counts(dds)[1,] <- rep(c(100L,200L,800L),each=4)
+
+design(dds) <- ~ group + condition
+
+# calling results too early
+expect_error(results(dds))
+
+dds <- DESeq(dds)
+head(coef(dds))
+res <- results(dds)
+show.res <- capture.output(show(res))
+summary.res <- summary(res)
+
+# various results error checking
+expect_error(results(dds, test="LRT"))
+expect_error(results(dds, altHypothesis="lessAbs"))
+expect_error(results(dds, name=c("Intercept","group1")))
+expect_error(results(dds, contrast=c("foo","B","A")))
+expect_error(results(dds, contrast=c("condition","4","1")))
+expect_error(results(dds, test="foo"))
+expect_error(results(dds, contrast=FALSE))
+expect_error(results(dds, contrast=letters[1:4]))
+expect_error(results(dds, contrast=c("condition","1","1")))
+results(dds, independentFiltering=FALSE)
+results(dds, contrast=list("condition1"))
+expect_error(results(dds, contrast=list("condition1","condition2","condition3")))
+expect_error(results(dds, contrast=list("condition1",1)))
+expect_error(results(dds, contrast=list("condition1","foo")))
+expect_error(results(dds, contrast=list("condition1","condition1")))
+expect_error(results(dds, contrast=list(character(), character())))
+expect_error(results(dds, contrast=rep(0, 6)))
+
+# check to see if the contrasts with expanded model matrix
+# are close to expected (although shrunk due to the beta prior)
+lfc31 <- results(dds,contrast=c("condition","3","1"))[1,2]
+lfc21 <- results(dds,contrast=c("condition","2","1"))[1,2]
+lfc32 <- results(dds,contrast=c("condition","3","2"))[1,2]
+expect_equal(lfc31, 3, tolerance=.1)
+expect_equal(lfc21, 1, tolerance=.1)
+expect_equal(lfc32, 2, tolerance=.1)
+expect_equal(results(dds,contrast=c("condition","1","3"))[1,2], -3, tolerance=.1)
+expect_equal(results(dds,contrast=c("condition","1","2"))[1,2], -1, tolerance=.1)
+expect_equal(results(dds,contrast=c("condition","2","3"))[1,2], -2, tolerance=.1)
+
+# check that results are not changed by releveling
+dds2 <- dds
+colData(dds2)$condition <- relevel(colData(dds2)$condition, "2")
+dds2 <- DESeq(dds2)
+expect_equal(results(dds2,contrast=c("condition","3","1"))[1,2], lfc31, tolerance=1e-6)
+expect_equal(results(dds2,contrast=c("condition","2","1"))[1,2], lfc21, tolerance=1e-6)
+expect_equal(results(dds2,contrast=c("condition","3","2"))[1,2], lfc32, tolerance=1e-6)
+
+# test a number of contrast as list options
+expect_equal(results(dds, contrast=list("condition3","condition1"))[1,2], lfc31, tolerance=1e-6)
+results(dds, contrast=list("condition3","condition1"), listValues=c(.5,-.5))
+results(dds, contrast=list("condition3",character()))
+results(dds, contrast=list("condition3",character()), listValues=c(.5,-.5))
+results(dds, contrast=list(character(),"condition1"))
+results(dds, contrast=list(character(),"condition1"), listValues=c(.5,-.5))
+
+# test no prior on intercept
+expect_equivalent(attr(dds,"betaPriorVar")[1], 1e6)
+
+# test thresholding
+results(dds, lfcThreshold=1)
+expect_error(results(dds, lfcThreshold=1, altHypothesis="lessAbs"))
+results(dds, lfcThreshold=1, altHypothesis="greater")
+results(dds, lfcThreshold=1, altHypothesis="less")
+
+ddsNoPrior <- DESeq(dds, betaPrior=FALSE)
+results(ddsNoPrior, lfcThreshold=1, altHypothesis="lessAbs")
+
+##################################################
+## test designs with zero intercept
+
+# test some special cases for results()
+# using designs with +0
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100,m=12)
+dds$condition <- factor(rep(1:3,each=4))
+dds$group <- factor(rep(1:2,length=ncol(dds)))
+
+counts(dds)[1,] <- rep(c(100L,200L,400L),each=4)
+
+design(dds) <- ~ condition + 0
+dds <- DESeq(dds, betaPrior=FALSE)
+
+expect_equal(results(dds)[1,2], 2, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","2","1"))[1,2], 1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","3","2"))[1,2], 1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","1","3"))[1,2], -2, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","1","2"))[1,2], -1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","2","3"))[1,2], -1, tolerance=.1)
+expect_error(results(dds, contrast=c("condition","4","1")))
+
+design(dds) <- ~ group + condition + 0
+dds <- DESeq(dds, betaPrior=FALSE)
+
+expect_equal(results(dds)[1,2], 2, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","2","1"))[1,2], 1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","3","2"))[1,2], 1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","1","3"))[1,2], -2, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","1","2"))[1,2], -1, tolerance=.1)
+expect_equal(results(dds, contrast=c("condition","2","3"))[1,2], -1, tolerance=.1)
+
+###############################################
+## test likelihood ratio test
+set.seed(1)
+dds <- makeExampleDESeqDataSet(n=100)
+dds$group <- factor(rep(1:2,6))
+design(dds) <- ~ group + condition
+dds <- DESeq(dds, test="LRT", reduced=~group)
+
+expect_true(!all(results(dds,name="condition_B_vs_A")$stat ==
+ results(dds,name="condition_B_vs_A",test="Wald")$stat))
+
+# LFC are already MLE
+expect_error(results(dds, addMLE=TRUE))
+expect_error(results(dds, lfcThreshold=1, test="LRT"))
+
+expect_true(all(results(dds, test="LRT", contrast=c("group","1","2"))$log2FoldChange ==
+ -1 * results(dds, test="LRT", contrast=c("group","2","1"))$log2FoldChange))
+
+###############################################
+## test results basics
+dds <- makeExampleDESeqDataSet(n=100)
+dds <- DESeq(dds)
+res <- results(dds, format="GRanges")
+expect_warning(results(dds, format="GRangesList"))
+
+rowRanges(dds) <- as(rowRanges(dds), "GRangesList")
+dds <- DESeq(dds)
+expect_warning(results(dds, format="GRanges"))
+
+# check tidy-ness
+res <- results(dds, tidy=TRUE)
+expect_true(colnames(res)[1] == "row")
+expect_true(is(res, "data.frame"))
+
+# test MLE and 'name'
+results(dds, addMLE=TRUE)
+expect_error(results(dds, name="condition_B_vs_A", addMLE=TRUE))
+
+# test remove results
+dds <- removeResults(dds)
+expect_true(!any(mcols(mcols(dds))$type == "results"))
+
+
diff --git a/tests/testthat/test_rlog.R b/tests/testthat/test_rlog.R
new file mode 100644
index 0000000..c6a2a6e
--- /dev/null
+++ b/tests/testthat/test_rlog.R
@@ -0,0 +1,24 @@
+# expect warning on sparsity and large counts
+dds <- makeExampleDESeqDataSet(n=100, m=20)
+idx <- sample(ncol(dds), nrow(dds)/2, TRUE)
+counts(dds)[cbind(1:(nrow(dds)/2), idx)] <- 10000L
+mcols(dds)$dispFit <- .5
+expect_warning({ rld <- rlog(dds, blind=FALSE) })
+
+# test rlog basics/errors
+dds <- makeExampleDESeqDataSet(n=20, m=4)
+colnames(dds) <- NULL
+rlog(dds)
+head(rlog(assay(dds)))
+expect_error(rlog(dds, intercept=rep(1,10)))
+
+mcols(dds)$dispFit <- rep(.5, 20)
+rlog(dds, blind=FALSE, intercept=rep(1,20))
+
+expect_error(rlogData(dds))
+expect_error(rlogData(dds, intercept=rep(1,10)))
+
+# test normTranform
+dds <- makeExampleDESeqDataSet(n=50, m=10)
+nt <- normTransform(dds)
+plotPCA(nt)
diff --git a/tests/testthat/test_size_factor.R b/tests/testthat/test_size_factor.R
new file mode 100644
index 0000000..46a1964
--- /dev/null
+++ b/tests/testthat/test_size_factor.R
@@ -0,0 +1,22 @@
+# size factor tests
+m <- matrix(1:16, ncol=4)
+expect_error(estimateSizeFactorsForMatrix(m, geoMeans=1:5))
+expect_error(estimateSizeFactorsForMatrix(m, geoMeans=rep(0,4)))
+expect_error(estimateSizeFactorsForMatrix(m, controlGenes="foo"))
+estimateSizeFactorsForMatrix(m, geoMeans=1:4)
+estimateSizeFactorsForMatrix(m, controlGenes=1:2)
+
+# iterate method
+true.sf <- 2^(rep(c(-2,-1,0,0,1,2),each=2))
+dds <- makeExampleDESeqDataSet(sizeFactors=true.sf, n=100)
+cts <- counts(dds)
+idx <- cbind(seq_len(nrow(cts)), sample(ncol(dds), nrow(cts), replace=TRUE))
+cts[idx] <- 0L
+cts[1,1] <- 1000000L # an outlier
+counts(dds) <- cts
+dds <- estimateSizeFactors(dds, type="iterate")
+sf <- sizeFactors(dds)
+coefs <- coef(lm(sf ~ true.sf))
+expect_true(abs(coefs[1]) < .1)
+expect_true(abs(coefs[2] - 1) < .1)
+
diff --git a/tests/testthat/test_vst.R b/tests/testthat/test_vst.R
new file mode 100644
index 0000000..e5e5ffa
--- /dev/null
+++ b/tests/testthat/test_vst.R
@@ -0,0 +1,18 @@
+dds <- makeExampleDESeqDataSet(n=100, m=4)
+design(dds) <- ~ 1
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersionsGeneEst(dds)
+dds <- estimateDispersionsFit(dds, fitType="parametric")
+vsd <- varianceStabilizingTransformation(dds, blind=FALSE)
+dds <- estimateDispersionsFit(dds, fitType="local")
+vsd <- varianceStabilizingTransformation(dds, blind=FALSE)
+dds <- estimateDispersionsFit(dds, fitType="mean")
+vsd <- varianceStabilizingTransformation(dds, blind=FALSE)
+
+# test VST basics/errors
+dds <- makeExampleDESeqDataSet(n=20, m=4)
+colnames(dds) <- NULL
+varianceStabilizingTransformation(dds)
+head(varianceStabilizingTransformation(assay(dds)))
+
+expect_error(getVarianceStabilizedData(dds))
diff --git a/tests/testthat/test_zero_zero.R b/tests/testthat/test_zero_zero.R
new file mode 100644
index 0000000..fd3e0c0
--- /dev/null
+++ b/tests/testthat/test_zero_zero.R
@@ -0,0 +1,18 @@
+# test comparison of two groups with all zeros
+dds <- makeExampleDESeqDataSet(m=8, n=100, sizeFactors=c(1,1,.5,.5,1,1,2,2))
+dds$condition <- factor(rep(c("A","B","C","D"),each=2))
+counts(dds)[1,] <- c(100L,110L,0L,0L,100L,110L,0L,0L)
+counts(dds)[2,] <- rep(0L, 8)
+dds <- DESeq(dds)
+res <- results(dds, contrast=c("condition","D","B"))[1,]
+expect_equal(res$log2FoldChange, 0)
+res <- results(dds, contrast=c(0,0,-1,0,1))[1,]
+expect_equal(res$log2FoldChange, 0)
+res <- results(dds,c(0,0,0,0,1))[1,]
+expect_true(res$log2FoldChange != 0)
+# if all samples have 0, should be NA
+res <- results(dds, contrast=c("condition","D","B"))[2,]
+expect_true(is.na(res$log2FoldChange))
+res <- results(dds, contrast=c(0,0,-1,0,1))[2,]
+expect_true(is.na(res$log2FoldChange))
+
diff --git a/vignettes/DESeq2.Rnw b/vignettes/DESeq2.Rnw
new file mode 100644
index 0000000..78543b6
--- /dev/null
+++ b/vignettes/DESeq2.Rnw
@@ -0,0 +1,2161 @@
+%\VignetteIndexEntry{Analyzing RNA-seq data with the "DESeq2" package}
+%\VignettePackage{DESeq2}
+%\VignetteEngine{knitr::knitr}
+
+% To compile this document
+% library('knitr'); rm(list=ls()); knit('DESeq2.Rnw')
+
+\documentclass[11pt]{article}
+
+\newcommand{\deseqtwo}{\textit{DESeq2}}
+\newcommand{\lowtilde}{\raise.17ex\hbox{$\scriptstyle\mathtt{\sim}$}}
+
+<<knitr, echo=FALSE, results="hide">>=
+library("knitr")
+opts_chunk$set(
+ tidy=FALSE,
+ dev="png",
+ fig.show="hide",
+ fig.width=4, fig.height=4.5,
+ cache=TRUE,
+ message=FALSE)
+@
+
+<<style, eval=TRUE, echo=FALSE, results="asis">>=
+BiocStyle::latex()
+@
+
+<<loadDESeq2, echo=FALSE>>=
+library("DESeq2")
+@
+
+
+\author{Michael I. Love$^{1}$, Simon Anders$^{2,3}$, Wolfgang Huber$^{3}$ \\[1em]
+ \small{$^{1}$ Department of Biostatistics, Dana-Farber Cancer Institute and} \\
+ \small{Harvard TH Chan School of Public Health, Boston, US;} \\
+ \small{$^{2}$ Institute for Molecular Medicine Finland (FIMM), Helsinki, Finland;} \\
+ \small{$^{3}$ European Molecular Biology Laboratory (EMBL), Heidelberg, Germany} }
+
+\title{Differential analysis of count data -- the DESeq2 package}
+
+\begin{document}
+
+\maketitle
+
+\begin{abstract}
+ A basic task in the analysis of count data from RNA-seq is the detection of
+ differentially expressed genes. The count data are presented as a table which reports,
+ for each sample, the number of sequence fragments that have been assigned to each
+ gene. Analogous data also arise for other assay types, including comparative ChIP-Seq,
+ HiC, shRNA screening, mass spectrometry. An important analysis question is the
+ quantification and statistical inference of systematic changes between conditions, as
+ compared to within-condition variability. The package \deseqtwo{} provides
+ methods to test for differential expression by use of negative binomial generalized
+ linear models; the estimates of dispersion and logarithmic fold changes
+ incorporate data-driven prior distributions\footnote{Other \Bioconductor{} packages
+ with similar aims are \Biocpkg{edgeR}, \Biocpkg{limma},
+ \Biocpkg{DSS}, \Biocpkg{EBSeq} and \Biocpkg{baySeq}.}.
+ This vignette explains the use of the package and demonstrates typical workflows.
+ An RNA-seq workflow\footnote{\url{http://www.bioconductor.org/help/workflows/rnaseqGene/}}
+ on the Bioconductor website covers similar material to this vignette
+ but at a slower pace, including the generation of count matrices
+ from FASTQ files.
+
+ \vspace{1em}
+
+ \textbf{DESeq2 version:} \Sexpr{packageVersion("DESeq2")}
+
+ \vspace{1em}
+
+ \begin{center}
+ \begin{tabular}{ | l | }
+ \hline
+ If you use \deseqtwo{} in published research, please cite: \\
+ \\
+ M. I. Love, W. Huber, S. Anders: \textbf{Moderated estimation of} \\
+ \textbf{fold change and dispersion for RNA-seq data with DESeq2}. \\
+ \emph{Genome Biology} 2014, \textbf{15}:550. \\
+ \url{http://dx.doi.org/10.1186/s13059-014-0550-8} \\
+ \hline
+ \end{tabular}
+ \end{center}
+
+\end{abstract}
+
+<<options, results="hide", echo=FALSE>>=
+options(digits=3, width=80, prompt=" ", continue=" ")
+@
+
+\newpage
+
+\tableofcontents
+
+\newpage
+
+\section{Standard workflow}
+
+\subsection{Quick start}
+
+Here we show the most basic steps for a differential expression analysis.
+These steps require you have a \Rclass{RangedSummarizedExperiment} object
+\Robject{se} which contains the counts and information about samples.
+The \Robject{design} indicates that we want to
+measure the effect of condition, controlling for batch differences.
+The two factor variables \Robject{batch} and \Robject{condition}
+should be columns of \Robject{colData(se)}.
+
+<<quick, eval=FALSE>>=
+dds <- DESeqDataSet(se, design = ~ batch + condition)
+dds <- DESeq(dds)
+res <- results(dds, contrast=c("condition","trt","con"))
+@
+
+If you have a count matrix and sample information table, the first
+line would use \Rfunction{DESeqDataSetFromMatrix} instead of
+\Rfunction{DESeqDataSet}, as shown in Section~\ref{sec:countmat}.
+
+\subsection{How to get help}
+
+All \deseqtwo{} questions should be posted to the Bioconductor support
+site: \url{https://support.bioconductor.org}, which serves as a
+repository of questions and answers. See the first question in the
+list of Frequently Asked Questions (Section \ref{sec:faq})
+for more information about how to construct an informative post.
+
+\subsection{Input data} \label{sec:prep}
+
+\subsubsection{Why raw counts?}
+
+As input, the \deseqtwo{} package expects count data as obtained, e.\,g.,
+from RNA-seq or another high-throughput sequencing experiment, in the form of a
+matrix of integer values. The value in the $i$-th row and the $j$-th column of
+the matrix tells how many reads have been mapped to gene $i$ in sample $j$.
+Analogously, for other types of assays, the rows of the matrix might correspond
+e.\,g.\ to binding regions (with ChIP-Seq) or peptide sequences (with
+quantitative mass spectrometry). We will list method for obtaining count tables
+in a section below.
+
+The count values must be raw counts of sequencing reads (for
+single-end RNA-seq) or fragments (for paired-end RNA-seq).
+The \href{http://www.bioconductor.org/help/workflows/rnaseqGene/}{RNA-seq workflow}
+describes multiple techniques for preparing such count matrices.
+It is important to provide count matrices as input for \deseqtwo{}'s
+statistical model \cite{Love2014} to hold, as only the
+count values allow assessing the measurement precision correctly. The \deseqtwo{}
+model internally corrects for library size, so transformed values such as counts
+scaled by library size should never be used as input.
+
+\subsubsection{\Rclass{SummarizedExperiment} input} \label{sec:sumExpInput}
+
+The class used by the \deseqtwo{} package to store the read counts
+is \Rclass{DESeqDataSet} which extends the \Rclass{RangedSummarizedExperiment}
+class of the \Biocpkg{SummarizedExperiment} package.
+This facilitates preparation steps and also downstream exploration of results.
+For counting aligned reads in genes, the \Rfunction{summarizeOverlaps} function of
+\Biocpkg{GenomicAlignments} with \Robject{mode="Union"} is
+encouraged, resulting in a \Rclass{RangedSummarizedExperiment} object.
+Other methods for obtaining count matrices are described in the next section.
+
+An example of the steps to produce a \Rclass{RangedSummarizedExperiment} can
+be found in an RNA-seq workflow on the Bioconductor
+website: \url{http://www.bioconductor.org/help/workflows/rnaseqGene/}
+and in the vignette for the data package \Biocexptpkg{airway}.
+Here we load the \Rclass{RangedSummarizedExperiment} from that package in
+order to build a \Rclass{DESeqDataSet}.
+
+<<loadSumExp>>=
+library("airway")
+data("airway")
+se <- airway
+@
+
+A \Rclass{DESeqDataSet} object must have an associated design formula.
+The design formula expresses the variables which will be
+used in modeling. The formula should be a tilde ($\sim$) followed by the
+variables with plus signs between them (it will be coerced into an
+\Rclass{formula} if it is not already). An intercept is included,
+representing the base mean of counts. The design can be changed later,
+however then all differential analysis steps should be repeated,
+as the design formula is used to estimate the dispersions and
+to estimate the log2 fold changes of the model.
+The constructor function below shows the generation of a
+\Rclass{DESeqDataSet} from a \Rclass{RangedSummarizedExperiment} \Robject{se}.
+
+\emph{Note}: In order to benefit from the default settings of the
+package, you should put the variable of interest at the end of the
+formula and make sure the control level is the first level.
+
+<<sumExpInput>>=
+library("DESeq2")
+ddsSE <- DESeqDataSet(se, design = ~ cell + dex)
+ddsSE
+@
+
+\subsubsection{Count matrix input} \label{sec:countmat}
+
+Alternatively, the function \Rfunction{DESeqDataSetFromMatrix} can be
+used if you already have a matrix of read counts prepared from another
+source. Another method for quickly producing count matrices
+from alignment files is the \Rfunction{featureCounts} function
+in the \Biocpkg{Rsubread} package.
+To use \Rfunction{DESeqDataSetFromMatrix}, the user should provide
+the counts matrix, the information about the samples (the columns of the
+count matrix) as a \Rclass{DataFrame} or \Rclass{data.frame},
+and the design formula.
+
+To demonstate the use of \Rfunction{DESeqDataSetFromMatrix},
+we will first load the \Robject{pasillaGenes}
+data object, pull out the count matrix which we will name \Robject{countData},
+and sample information, \Robject{colData}. Below we describe how to extract
+these objects from, e.g. \Rfunction{featureCounts} output.
+
+<<loadPasilla>>=
+library("pasilla")
+library("Biobase")
+data("pasillaGenes")
+countData <- counts(pasillaGenes)
+colData <- pData(pasillaGenes)[,c("condition","type")]
+@
+
+The count matrix and column data:
+
+<<showPasilla>>=
+head(countData)
+head(colData)
+@
+
+If you have used the \Rfunction{featureCounts} function in the
+\Biocpkg{Rsubread} package, the matrix of read counts can be directly
+provided from the \Robject{"counts"} element in the list output.
+The count matrix and column data can also be read into R
+from flat files using base R functions such as \Rfunction{read.csv}
+or \Rfunction{read.delim}.
+For \textit{HTSeq} count files, see the dedicated input function below.
+
+With the count matrix, \Robject{countData}, and the sample
+information, \Robject{colData}, we can construct a \Rclass{DESeqDataSet}:
+
+<<matrixInput>>=
+dds <- DESeqDataSetFromMatrix(countData = countData,
+ colData = colData,
+ design = ~ condition)
+dds
+@
+
+If you have additional feature data, it can be added to the
+\Rclass{DESeqDataSet} by adding to the metadata columns of a newly
+constructed object. (Here we add redundant data just for demonstration, as
+the gene names are already the rownames of the \Robject{dds}.)
+
+<<addFeatureData>>=
+featureData <- data.frame(gene=rownames(pasillaGenes))
+(mcols(dds) <- DataFrame(mcols(dds), featureData))
+@
+
+\subsubsection{\textit{HTSeq} input}
+
+You can use the function \Rfunction{DESeqDataSetFromHTSeqCount} if you
+have \texttt{htseq-count} from the \textit{HTSeq} python
+package\footnote{available from \url{http://www-huber.embl.de/users/anders/HTSeq}, described in \cite{Anders:2014:htseq}}.
+For an example of using the python scripts, see the
+\Biocexptpkg{pasilla} data package. First you will want to specify a
+variable which points to the directory in which the \textit{HTSeq}
+output files are located.
+
+<<htseqDirI, eval=FALSE>>=
+directory <- "/path/to/your/files/"
+@
+
+However, for demonstration purposes only, the following line of
+code points to the directory for the demo \textit{HTSeq} output
+files packages for the \Biocexptpkg{pasilla} package.
+
+<<htseqDirII>>=
+directory <- system.file("extdata", package="pasilla", mustWork=TRUE)
+@
+
+We specify which files to read in using \Rfunction{list.files},
+and select those files which contain the string \Robject{"treated"}
+using \Rfunction{grep}. The \Rfunction{sub} function is used to
+chop up the sample filename to obtain the condition status, or
+you might alternatively read in a phenotypic table
+using \Rfunction{read.table}.
+
+<<htseqInput>>=
+sampleFiles <- grep("treated",list.files(directory),value=TRUE)
+sampleCondition <- sub("(.*treated).*","\\1",sampleFiles)
+sampleTable <- data.frame(sampleName = sampleFiles,
+ fileName = sampleFiles,
+ condition = sampleCondition)
+ddsHTSeq <- DESeqDataSetFromHTSeqCount(sampleTable = sampleTable,
+ directory = directory,
+ design= ~ condition)
+ddsHTSeq
+@
+
+\subsubsection{Pre-filtering}
+
+While it is not necessary to pre-filter low count genes before running the \deseqtwo{}
+functions, there are two reasons which make pre-filtering useful:
+by removing rows in which there are no reads or nearly no reads,
+we reduce the memory size of the \Robject{dds} data object and
+we increase the speed of the transformation
+and testing functions within \deseqtwo{}. Here we perform a minimal
+pre-filtering to remove rows that have only 0 or 1 read. Note that more strict
+filtering to increase power is \textit{automatically} applied via independent filtering
+on the mean of normalized counts within the \Rfunction{results}
+function, which will be discussed in Section~\ref{sec:autoFilt}.
+
+<<prefilter>>=
+dds <- dds[ rowSums(counts(dds)) > 1, ]
+@
+
+\subsubsection{Note on factor levels} \label{sec:factorLevels}
+
+By default, R will choose a \textit{reference level} for factors based
+on alphabetical order. Then, if you never tell the \deseqtwo{} 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 \Rfunction{results} which comparison to make using the
+\Robject{contrast} argument (this will be shown later), or you can
+explicitly set the factors levels. Setting the factor levels can be done in two ways,
+either using factor:
+
+<<factorlvl>>=
+dds$condition <- factor(dds$condition, levels=c("untreated","treated"))
+@
+
+...or using \Rfunction{relevel}, just specifying the reference level:
+
+<<relevel>>=
+dds$condition <- relevel(dds$condition, ref="untreated")
+@
+
+If you need to subset the columns of a \Rclass{DESeqDataSet},
+i.e., when removing certain samples from the analysis, it is possible
+that all the samples for one or more levels of a variable in the design
+formula would be removed. In this case, the \Rfunction{droplevels} function can be used
+to remove those levels which do not have samples in the current \Rclass{DESeqDataSet}:
+
+<<droplevels>>=
+dds$condition <- droplevels(dds$condition)
+@
+
+\subsubsection{Collapsing technical replicates}
+
+\deseqtwo{} provides a function \Rfunction{collapseReplicates} which can
+assist in combining the counts from technical replicates into single
+columns. See the manual page for an example of the use of
+\Rfunction{collapseReplicates}.
+
+\subsubsection{About the pasilla dataset}
+
+We continue with the \Biocexptpkg{pasilla} data constructed from the
+count matrix method above. This data set is from an experiment on
+\emph{Drosophila melanogaster} cell cultures and investigated the
+effect of RNAi knock-down of the splicing factor \emph{pasilla}
+\cite{Brooks2010}. The detailed transcript of the production of
+the \Biocexptpkg{pasilla} data is provided in the vignette of the
+data package \Biocexptpkg{pasilla}.
+
+\subsection{Differential expression analysis} \label{sec:de}
+
+The standard differential expression analysis steps are wrapped
+into a single function, \Rfunction{DESeq}. The estimation steps performed
+by this function are described in Section~\ref{sec:glm}, in the manual page for
+\Robject{?DESeq} and in the Methods section of the \deseqtwo{} publication \cite{Love2014}.
+The individual sub-functions which are called by \Rfunction{DESeq}
+are still available, described in Section~\ref{sec:steps}.
+
+Results tables are generated using the function \Rfunction{results}, which
+extracts a results table with log2 fold changes, $p$ values and adjusted
+$p$ values. With no arguments to \Rfunction{results}, the results will be for
+the last variable in the design formula, and if this is a factor,
+the comparison will be the last level of this variable over the first level.
+Details about the comparison are printed to the console. The text, \texttt{condition}
+\texttt{treated vs untreated}, tells you that the estimates are of the logarithmic
+fold change $\log_2 ( \textrm{treated} / \textrm{untreated} )$.
+
+<<deseq>>=
+dds <- DESeq(dds)
+res <- results(dds)
+res
+@
+
+These steps should take less than 30 seconds for most analyses. For
+experiments with many samples (e.g. 100 samples), one can take
+advantage of parallelized computation. Both of the above functions
+have an argument \Robject{parallel} which if set to \Robject{TRUE} can
+be used to distribute computation across cores specified by the
+\Rfunction{register} function of \Biocpkg{BiocParallel}. For example,
+the following chunk (not evaluated here), would register 4 cores, and
+then the two functions above, with \Robject{parallel=TRUE}, would
+split computation over these cores.
+
+<<parallel, eval=FALSE>>=
+library("BiocParallel")
+register(MulticoreParam(4))
+@
+
+We can order our results table by the smallest adjusted $p$ value:
+
+<<resOrder>>=
+resOrdered <- res[order(res$padj),]
+@
+
+We can summarize some basic tallies using the
+\Rfunction{summary} function.
+
+<<sumRes>>=
+summary(res)
+@
+
+How many adjusted p-values were less than 0.1?
+
+<<sumRes01>>=
+sum(res$padj < 0.1, na.rm=TRUE)
+@
+
+The \Rfunction{results} function contains a number of arguments to
+customize the results table which is generated. Note that the
+\Rfunction{results} function automatically performs independent
+filtering based on the mean of normalized counts for each gene,
+optimizing the number of genes which will have an adjusted $p$ value
+below a given FDR cutoff, \Robject{alpha}.
+Independent filtering is further discussed in Section~\ref{sec:autoFilt}.
+By default the argument
+\Robject{alpha} is set to $0.1$. If the adjusted $p$ value cutoff
+will be a value other than $0.1$, \Robject{alpha} should be set to
+that value:
+
+<<resAlpha05>>=
+res05 <- results(dds, alpha=0.05)
+summary(res05)
+sum(res05$padj < 0.05, na.rm=TRUE)
+@
+
+
+If a multi-factor design is used, or if the variable in the design
+formula has more than two levels, the \Robject{contrast} argument of
+\Rfunction{results} can be used to extract different comparisons from
+the \Rclass{DESeqDataSet} returned by \Rfunction{DESeq}.
+Multi-factor designs are discussed further in Section~\ref{sec:multifactor},
+and the use of the \Robject{contrast} argument is dicussed in Section~\ref{sec:contrasts}.
+
+For advanced users, note that all the values calculated by the \deseqtwo{}
+package are stored in the \Rclass{DESeqDataSet} object, and access
+to these values is discussed in Section~\ref{sec:access}.
+
+\subsection{Exploring and exporting results}
+
+\subsubsection{MA-plot}
+
+\begin{figure}
+\centering
+\includegraphics[width=.45\textwidth]{figure/MANoPrior-1}
+\includegraphics[width=.45\textwidth]{figure/MA-1}
+\caption{
+ \textbf{MA-plot.}
+ These plots show the log2 fold changes from the treatment over
+ the mean of normalized counts, i.e. the average of counts normalized by
+ size factors. The left plot shows the ``unshrunken'' log2 fold changes,
+ while the right plot, produced by the code above, shows the shrinkage
+ of log2 fold changes resulting from the incorporation of zero-centered
+ normal prior. The shrinkage is greater for the log2 fold change
+ estimates from genes with low counts and high dispersion,
+ as can be seen by the narrowing of spread of leftmost points
+ in the right plot.}
+\label{fig:MA}
+\end{figure}
+
+In \deseqtwo{}, the function \Rfunction{plotMA} shows the log2
+fold changes attributable to a given variable over the mean of normalized counts.
+Points will be colored red if the adjusted $p$ value is less than 0.1.
+Points which fall out of the window are plotted as open triangles pointing
+either up or down.
+
+<<MA, fig.width=4.5, fig.height=4.5>>=
+plotMA(res, main="DESeq2", ylim=c(-2,2))
+@
+
+After calling \Rfunction{plotMA}, one can use the function
+\Rfunction{identify} to interactively detect the row number of
+individual genes by clicking on the plot. One can then recover
+the gene identifiers by saving the resulting indices:
+
+<<MAidentify, eval=FALSE>>=
+idx <- identify(res$baseMean, res$log2FoldChange)
+rownames(res)[idx]
+@
+
+The MA-plot of log2 fold changes returned by \deseqtwo{} allows us to
+see how the shrinkage of fold changes works for genes with low
+counts. You can still obtain results tables which include the
+``unshrunken'' log2 fold changes (for a simple comparison, the ratio
+of the mean normalized counts in the two groups). A column
+\Robject{lfcMLE} with the unshrunken maximum likelihood estimate (MLE)
+for the log2 fold change will be added with an additional argument to
+\Rfunction{results}:
+
+<<resMLE>>=
+resMLE <- results(dds, addMLE=TRUE)
+head(resMLE, 4)
+@
+
+One can make an MA-plot of the unshrunken estimates like so:
+
+<<MANoPrior, fig.width=4.5, fig.height=4.5>>=
+plotMA(resMLE, MLE=TRUE, main="unshrunken LFC", ylim=c(-2,2))
+@
+
+\subsubsection{Plot counts} \label{sec:plotcounts}
+
+It can also be useful to examine the counts of reads for a single gene
+across the groups. A simple function for making this
+plot is \Rfunction{plotCounts}, which normalizes counts by sequencing depth
+and adds a pseudocount of $\frac{1}{2}$ to allow for log scale plotting.
+The counts are grouped by the variables in \Robject{intgroup}, where
+more than one variable can be specified. Here we specify the gene
+which had the smallest $p$ value from the results table created
+above. You can select the gene to plot by rowname or by numeric index.
+
+<<plotCounts, dev="pdf", fig.width=4.5, fig.height=5>>=
+plotCounts(dds, gene=which.min(res$padj), intgroup="condition")
+@
+
+For customized plotting, an argument \Robject{returnData} specifies
+that the function should only return a \Rclass{data.frame} for
+plotting with \Rfunction{ggplot}.
+
+<<plotCountsAdv, dev="pdf", fig.width=3.5, fig.height=3.5>>=
+d <- plotCounts(dds, gene=which.min(res$padj), intgroup="condition",
+ returnData=TRUE)
+library("ggplot2")
+ggplot(d, aes(x=condition, y=count)) +
+ geom_point(position=position_jitter(w=0.1,h=0)) +
+ scale_y_log10(breaks=c(25,100,400))
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.45\textwidth]{figure/plotCounts-1}
+\includegraphics[width=.45\textwidth]{figure/plotCountsAdv-1}
+\caption{
+ \textbf{Plot of counts for one gene.}
+ The plot of normalized counts (plus a pseudocount of $\frac{1}{2}$)
+ either made using the \Rfunction{plotCounts} function (left)
+ or using another plotting library (right, using \CRANpkg{ggplot2}).}
+\label{fig:plotcounts}
+\end{figure}
+
+\subsubsection{More information on results columns} \label{sec:moreInfo}
+
+Information about which variables and tests were used can be found by calling
+the function \Rfunction{mcols} on the results object.
+
+<<metadata>>=
+mcols(res)$description
+@
+
+For a particular gene, a log2 fold change of $-1$ for
+\Robject{condition treated vs untreated} means that the treatment
+induces a multiplicative change in observed gene expression level of
+$2^{-1} = 0.5$ compared to the untreated condition. If the variable of
+interest is continuous-valued, then the reported log2 fold change is
+per unit of change of that variable.
+
+\textbf{Note on p-values set to NA}: some values in the results table
+can be set to \Robject{NA} for one of the following reasons:
+
+\begin{enumerate}
+ \item If within a row, all samples have zero counts,
+ the \Robject{baseMean} column will be zero, and the
+ log2 fold change estimates, $p$ value and adjusted $p$ value
+ will all be set to \texttt{NA}.
+ \item If a row contains a sample with an extreme count outlier
+ then the $p$ value and adjusted $p$ value will be set to \texttt{NA}.
+ These outlier counts are detected by Cook's distance. Customization
+ of this outlier filtering and description of functionality for
+ replacement of outlier counts and refitting is described in
+ Section~\ref{sec:outlierApproach},
+ \item If a row is filtered by automatic independent filtering,
+ for having a low mean normalized count, then only the adjusted $p$
+ value will be set to \texttt{NA}.
+ Description and customization of independent filtering is
+ described in Section~\ref{sec:autoFilt}.
+\end{enumerate}
+
+\subsubsection{Exporting results to HTML or CSV files}
+An HTML report of the results with plots and sortable/filterable columns
+can be exported using the \Biocpkg{ReportingTools} package
+on a \Rclass{DESeqDataSet} that has been processed by the \Rfunction{DESeq} function.
+For a code example, see the ``RNA-seq differential expression'' vignette at
+the \Biocpkg{ReportingTools} page, or the manual page for the
+\Rfunction{publish} method for the \Rclass{DESeqDataSet} class.
+
+A plain-text file of the results can be exported using the
+base \R{} functions \Rfunction{write.csv} or \Rfunction{write.delim}.
+We suggest using a descriptive file name indicating the variable
+and levels which were tested.
+
+<<export, eval=FALSE>>=
+write.csv(as.data.frame(resOrdered),
+ file="condition_treated_results.csv")
+@
+
+Exporting only the results which pass an adjusted $p$ value
+threshold can be accomplished with the \Rfunction{subset} function,
+followed by the \Rfunction{write.csv} function.
+
+<<subset>>=
+resSig <- subset(resOrdered, padj < 0.1)
+resSig
+@
+
+\subsection{Multi-factor designs} \label{sec:multifactor}
+
+Experiments with more than one factor influencing the counts can be
+analyzed using design formula that include the additional variables.
+By adding these to the design, one can control for additional variation
+in the counts. For example, if the condition samples are balanced
+across experimental batches, by including the \Robject{batch} factor to the
+design, one can increase the sensitivity for finding differences due
+to \Robject{condition}. There are multiple ways to analyze experiments when the
+additional variables are of interest and not just controlling factors
+(see Section \ref{sec:interactions} on interactions).
+
+The data in the \Biocexptpkg{pasilla} package have a condition of interest
+(the column \Robject{condition}), as well as information on the type of sequencing
+which was performed (the column \Robject{type}), as we can see below:
+
+<<multifactor>>=
+colData(dds)
+@
+
+We create a copy of the \Rclass{DESeqDataSet}, so that we can rerun
+the analysis using a multi-factor design.
+
+<<copyMultifactor>>=
+ddsMF <- dds
+@
+
+We can account for the different types of sequencing, and get a clearer picture
+of the differences attributable to the treatment. As \Robject{condition} is the
+variable of interest, we put it at the end of the formula. Thus the \Rfunction{results}
+function will by default pull the \Robject{condition} results unless
+\Robject{contrast} or \Robject{name} arguments are specified.
+Then we can re-run \Rfunction{DESeq}:
+
+<<replaceDesign>>=
+design(ddsMF) <- formula(~ type + condition)
+ddsMF <- DESeq(ddsMF)
+@
+
+Again, we access the results using the \Rfunction{results} function.
+
+<<multiResults>>=
+resMF <- results(ddsMF)
+head(resMF)
+@
+
+It is also possible to retrieve the log2 fold changes, $p$ values and adjusted
+$p$ values of the \Robject{type} variable. The \Robject{contrast} argument of
+the function \Rfunction{results} takes a character vector of length three:
+the name of the variable, the name of the factor level for the numerator
+of the log2 ratio, and the name of the factor level for the denominator.
+The \Robject{contrast} argument can also take other forms, as
+described in the help page for \Rfunction{results} and in Section~\ref{sec:contrasts}.
+
+<<multiTypeResults>>=
+resMFType <- results(ddsMF, contrast=c("type","single-read","paired-end"))
+head(resMFType)
+@
+
+If the variable is continuous or an interaction term (see Section~\ref{sec:interactions})
+then the results can be extracted using the \Robject{name} argument to \Rfunction{results},
+where the name is one of elements returned by \Robject{resultsNames(dds)}.
+
+\newpage
+
+%---------------------------------------------------
+\section{Data transformations and visualization} \label{sec:transf}
+%---------------------------------------------------
+\subsection{Count data transformations}
+%---------------------------------------------------
+
+In order to test for differential expression, we operate on raw counts
+and use discrete distributions as described in the previous Section~\ref{sec:de}.
+However for other downstream analyses --
+e.g. for visualization or clustering -- it might be useful
+to work with transformed versions of the count data.
+
+Maybe the most obvious choice of transformation is the logarithm.
+Since count values for a gene can be zero in some
+conditions (and non-zero in others), some advocate the use of
+\emph{pseudocounts}, i.\,e.\ transformations of the form
+
+\begin{equation}\label{eq:shiftedlog}
+ y = \log_2(n + 1)\quad\mbox{or more generally,}\quad y = \log_2(n + n_0),
+\end{equation}
+
+where $n$ represents the count values and $n_0$ is a positive constant.
+
+In this section, we discuss two alternative
+approaches that offer more theoretical justification and a rational way
+of choosing the parameter equivalent to $n_0$ above.
+The \emph{regularized logarithm} or \emph{rlog} incorporates a prior on
+the sample differences \cite{Love2014},
+and the other uses the concept of variance stabilizing
+transformations (VST) \cite{Tibshirani1988,sagmb2003,Anders:2010:GB}.
+Both transformations produce transformed data on the $\log_2$ scale
+which has been normalized with respect to library size.
+
+The point of these two transformations, the \emph{rlog} and the VST,
+is to remove the dependence of the variance on the mean,
+particularly the high variance of the logarithm of count data when the
+mean is low. Both \emph{rlog} and VST use the experiment-wide trend
+of variance over mean, in order to transform the data to remove the
+experiment-wide trend. Note that we do not require or
+desire that all the genes have \emph{exactly} the same variance after
+transformation. Indeed, in Figure~\ref{fig:meansd} below, you will see
+that after the transformations the genes with the same mean do not
+have exactly the same standard deviations, but that the
+experiment-wide trend has flattened. It is those genes with row
+variance above the trend which will allow us to cluster samples into
+interesting groups.
+
+\textbf{Note on running time:} if you have many samples (e.g. 100s),
+the \Rfunction{rlog} function might take too long, and the variance
+stabilizing transformation might be a better choice. The rlog and VST
+have similar properties, but the rlog requires fitting a shrinkage
+term for each sample and each gene which takes time. See the
+\deseqtwo{} paper for more discussion on the differences
+\cite{Love2014}.
+
+\subsubsection{Blind dispersion estimation}
+
+The two functions, \Rfunction{rlog} and
+\Rfunction{varianceStabilizingTransformation}, have an argument
+\Robject{blind}, for whether the transformation should be blind to the
+sample information specified by the design formula. When
+\Robject{blind} equals \Robject{TRUE} (the default), the functions
+will re-estimate the dispersions using only an intercept (design
+formula $\sim 1$). This setting should be used in order to compare
+samples in a manner wholly unbiased by the information about
+experimental groups, for example to perform sample QA (quality
+assurance) as demonstrated below.
+
+However, blind dispersion estimation is not the appropriate choice if
+one expects that many or the majority of genes (rows) will have large
+differences in counts which are explainable by the experimental design,
+and one wishes to tranform the data for downstream analysis. In this
+case, using blind dispersion estimation will lead to large estimates
+of dispersion, as it attributes differences due to experimental design
+as unwanted ``noise'', and will result in overly shrinking the transformed
+values towards each other.
+By setting \Robject{blind} to \Robject{FALSE}, the dispersions
+already estimated will be used to perform transformations, or if not
+present, they will be estimated using the current design formula. Note
+that only the fitted dispersion estimates from mean-dispersion trend
+line are used in the transformation (the global dependence of
+dispersion on mean for the entire experiment).
+So setting \Robject{blind} to \Robject{FALSE} is still for the most
+part unbiased by the information about which samples were in which
+experimental group.
+
+\subsubsection{Extracting transformed values}
+
+The two functions return an object of class \Rclass{DESeqTransform}
+which is a subclass of \Rclass{RangedSummarizedExperiment}.
+The \Rfunction{assay} function is used to extract the matrix of normalized values:
+
+<<rlogAndVST>>=
+rld <- rlog(dds)
+vsd <- varianceStabilizingTransformation(dds)
+head(assay(rld), 3)
+@
+
+\subsubsection{Regularized log transformation}
+
+The function \Rfunction{rlog}, stands for \emph{regularized log},
+transforming the original count data to the log2 scale by fitting a
+model with a term for each sample and a prior distribution on the
+coefficients which is estimated from the data. This is the same kind
+of shrinkage (sometimes referred to as regularization, or moderation)
+of log fold changes used by the \Rfunction{DESeq} and
+\Rfunction{nbinomWaldTest}, as seen in Figure \ref{fig:MA}. The
+resulting data contains elements defined as:
+
+$$ \log_2(q_{ij}) = \beta_{i0} + \beta_{ij} $$
+
+where $q_{ij}$ is a parameter proportional to the expected true
+concentration of fragments for gene $i$ and sample $j$ (see
+Section~\ref{sec:glm}), $\beta_{i0}$ is an intercept which does not
+undergo shrinkage, and $\beta_{ij}$ is the sample-specific effect
+which is shrunk toward zero based on the dispersion-mean trend over
+the entire dataset. The trend typically captures high dispersions for
+low counts, and therefore these genes exhibit higher shrinkage from
+the\Rfunction{rlog}.
+
+Note that, as $q_{ij}$ represents the part of the mean value
+$\mu_{ij}$ after the size factor $s_j$ has been divided out, it is
+clear that the rlog transformation inherently accounts for differences
+in sequencing depth. Without priors, this design matrix would lead to
+a non-unique solution, however the addition of a prior on
+non-intercept betas allows for a unique solution to be found. The
+regularized log transformation is preferable to the variance
+stabilizing transformation if the size factors vary widely.
+
+\subsubsection{Variance stabilizing transformation}
+
+Above, we used a parametric fit for the dispersion. In this case, the
+closed-form expression for the variance stabilizing transformation is
+used by \Rfunction{varianceStabilizingTransformation}, which is
+derived in the file \texttt{vst.pdf}, that is distributed in the
+package alongside this vignette. If a local fit is used (option
+\Robject{fitType="locfit"} to \Rfunction{estimateDispersions}) a
+numerical integration is used instead.
+
+The resulting variance stabilizing transformation is shown in Figure
+\ref{figure/vsd1-1}. The code that produces the figure is hidden from
+this vignette for the sake of brevity, but can be seen in the
+\texttt{.Rnw} or \texttt{.R} source file. Note that the vertical axis
+in such plots is the square root of the variance over all samples, so
+including the variance due to the experimental conditions. While a
+flat curve of the square root of variance over the mean may seem like
+the goal of such transformations, this may be unreasonable in the case
+of datasets with many true differences due to the experimental
+conditions.
+
+<<vsd1, echo=FALSE, fig.width=4.5, fig.height=4.5>>=
+px <- counts(dds)[,1] / sizeFactors(dds)[1]
+ord <- order(px)
+ord <- ord[px[ord] < 150]
+ord <- ord[seq(1, length(ord), length=50)]
+last <- ord[length(ord)]
+vstcol <- c("blue", "black")
+matplot(px[ord],
+ cbind(assay(vsd)[, 1], log2(px))[ord, ],
+ type="l", lty=1, col=vstcol, xlab="n", ylab="f(n)")
+legend("bottomright",
+ legend = c(
+ expression("variance stabilizing transformation"),
+ expression(log[2](n/s[1]))),
+ fill=vstcol)
+@
+
+\incfig{figure/vsd1-1}{.49\textwidth}{VST and log2.}{
+ Graphs of the variance stabilizing transformation for
+ sample 1, in blue, and of the transformation $f(n) = \log_2(n/s_1)$, in
+ black. $n$ are the counts and $s_1$ is the size factor for the first sample.
+}
+
+\subsubsection{Effects of transformations on the variance}
+
+\begin{figure}
+\centering
+\includegraphics[width=.32\textwidth]{figure/log2meansd-1}
+\includegraphics[width=.32\textwidth]{figure/rlogmeansd-1}
+\includegraphics[width=.32\textwidth]{figure/vstmeansd-1}
+\caption{Per-gene standard deviation (taken across samples), against the rank
+ of the mean, for the shifted logarithm $\log_2(n+1)$ (left), the
+ regularized log transformation (center) and the variance stabilizing
+ transformation (right).}
+\label{fig:meansd}
+\end{figure}
+
+Figure~\ref{fig:meansd} plots the standard deviation of the transformed
+data, across samples, against the mean, using the shifted
+logarithm transformation (\ref{eq:shiftedlog}), the
+regularized log transformation and the variance stabilizing transformation.
+The shifted logarithm has elevated standard deviation in the lower
+count range, and the regularized log to a lesser extent, while for
+the variance stabilized data the standard deviation is roughly constant
+along the whole dynamic range.
+
+<<log2meansd, fig.width=4, fig.height=3>>=
+library("vsn")
+notAllZero <- (rowSums(counts(dds))>0)
+meanSdPlot(log2(counts(dds,normalized=TRUE)[notAllZero,] + 1))
+@
+
+<<rlogmeansd, fig.width=4, fig.height=3>>=
+meanSdPlot(assay(rld[notAllZero,]))
+@
+
+<<vstmeansd, fig.width=4, fig.height=3>>=
+meanSdPlot(assay(vsd[notAllZero,]))
+@
+
+
+%---------------------------------------------------------------
+\subsection{Data quality assessment by sample clustering and visualization}\label{sec:quality}
+%---------------------------------------------------------------
+
+Data quality assessment and quality control (i.\,e.\ the removal of
+insufficiently good data) are essential steps of any data
+analysis. These steps should typically be performed
+very early in the analysis of a new data set,
+preceding or in parallel to the differential expression testing.
+
+We define the term \emph{quality} as
+\emph{fitness for purpose}\footnote{\url{http://en.wikipedia.org/wiki/Quality_\%28business\%29}}.
+Our purpose is the detection of differentially expressed genes, and we
+are looking in particular for samples whose experimental treatment
+suffered from an anormality that renders the data points obtained from
+these particular samples detrimental to our purpose.
+
+\subsubsection{Heatmap of the count matrix}\label{sec:hmc}
+To explore a count matrix, it is often instructive to look at it as a
+heatmap. Below we show how to produce such a heatmap
+for various transformations of the data.
+
+<<heatmap>>=
+library("pheatmap")
+select <- order(rowMeans(counts(dds,normalized=TRUE)),decreasing=TRUE)[1:20]
+@
+
+<<figHeatmap2a, dev="pdf", fig.width=5, fig.height=7>>=
+nt <- normTransform(dds) # defaults to log2(x+1)
+log2.norm.counts <- assay(nt)[select,]
+df <- as.data.frame(colData(dds)[,c("condition","type")])
+pheatmap(log2.norm.counts, cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+<<figHeatmap2b, dev="pdf", fig.width=5, fig.height=7>>=
+pheatmap(assay(rld)[select,], cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+<<figHeatmap2c, dev="pdf", fig.width=5, fig.height=7>>=
+pheatmap(assay(vsd)[select,], cluster_rows=FALSE, show_rownames=FALSE,
+ cluster_cols=FALSE, annotation_col=df)
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2a-1}
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2b-1}
+\includegraphics[width=.32\textwidth]{figure/figHeatmap2c-1}
+\caption{Heatmaps showing the expression data of the \Sexpr{length(select)}
+ most highly expressed genes. The data is of log2 normalized counts (left),
+ from regularized log transformation (center) and from variance
+ stabilizing transformation (right).}
+\label{fig:heatmap2}
+\end{figure}
+
+\incfig{figure/figHeatmapSamples-1}{.6\textwidth}{Sample-to-sample distances.}{
+ Heatmap showing the Euclidean distances between the samples
+ as calculated from the regularized log transformation.
+}
+
+\subsubsection{Heatmap of the sample-to-sample distances}\label{sec:dists}
+
+Another use of the transformed data is sample clustering. Here, we apply the
+\Rfunction{dist} function to the transpose of the transformed count matrix to get
+sample-to-sample distances. We could alternatively use the variance stabilized
+transformation here.
+
+<<sampleClust>>=
+sampleDists <- dist(t(assay(rld)))
+@
+
+A heatmap of this distance matrix gives us an overview over similarities
+and dissimilarities between samples (Figure \ref{figure/figHeatmapSamples-1}):
+We have to provide a hierarchical clustering \Robject{hc} to the heatmap
+function based on the sample distances, or else the heatmap
+function would calculate a clustering based on the distances between
+the rows/columns of the distance matrix.
+
+<<figHeatmapSamples, dev="pdf", fig.width=7, fig.height=7>>=
+library("RColorBrewer")
+sampleDistMatrix <- as.matrix(sampleDists)
+rownames(sampleDistMatrix) <- paste(rld$condition, rld$type, sep="-")
+colnames(sampleDistMatrix) <- NULL
+colors <- colorRampPalette( rev(brewer.pal(9, "Blues")) )(255)
+pheatmap(sampleDistMatrix,
+ clustering_distance_rows=sampleDists,
+ clustering_distance_cols=sampleDists,
+ col=colors)
+@
+
+\subsubsection{Principal component plot of the samples}\label{sec:pca}
+
+Related to the distance matrix of Section~\ref{sec:dists} is the PCA
+plot of the samples, which we obtain as follows (Figure \ref{figure/figPCA-1}).
+
+<<figPCA, dev="pdf", fig.width=5, fig.height=3>>=
+plotPCA(rld, intgroup=c("condition", "type"))
+@
+
+\incfig{figure/figPCA-1}{.7\textwidth}{PCA plot.}{
+ PCA plot. The \Sexpr{ncol(rld)} samples shown in the 2D
+ plane spanned by their first two principal components. This type of
+ plot is useful for visualizing the overall effect of experimental
+ covariates and batch effects.
+}
+
+It is also possible to customize the PCA plot using the
+\Rfunction{ggplot} function.
+
+<<figPCA2, dev="pdf", fig.width=5, fig.height=3>>=
+data <- plotPCA(rld, intgroup=c("condition", "type"), returnData=TRUE)
+percentVar <- round(100 * attr(data, "percentVar"))
+ggplot(data, aes(PC1, PC2, color=condition, shape=type)) +
+ geom_point(size=3) +
+ xlab(paste0("PC1: ",percentVar[1],"% variance")) +
+ ylab(paste0("PC2: ",percentVar[2],"% variance"))
+@
+
+\incfig{figure/figPCA2-1}{.7\textwidth}{PCA plot.}{
+ PCA plot customized using the \CRANpkg{ggplot2} library.
+}
+
+
+\newpage
+
+%--------------------------------------------------
+\section{Variations to the standard workflow}
+%--------------------------------------------------
+
+\subsection{Wald test individual steps} \label{sec:steps}
+
+The function \Rfunction{DESeq} runs the following functions in order:
+
+<<WaldTest, eval=FALSE>>=
+dds <- estimateSizeFactors(dds)
+dds <- estimateDispersions(dds)
+dds <- nbinomWaldTest(dds)
+@
+
+\subsection{Contrasts} \label{sec:contrasts}
+
+A contrast is a linear combination of estimated log2 fold changes,
+which can be used to test if differences between groups are equal to
+zero. The simplest use case for contrasts is an experimental design
+containing a factor with three levels, say A, B and C. Contrasts
+enable the user to generate results for all 3 possible differences:
+log2 fold change of B vs A, of C vs A, and of C vs B.
+The \Robject{contrast} argument of \Rfunction{results} function is
+used to extract test results of log2 fold changes of interest, for example:
+
+<<simpleContrast, eval=FALSE>>=
+results(dds, contrast=c("condition","C","B"))
+@
+
+Log2 fold changes can also be added and subtracted by providing a
+\Robject{list} to the \Robject{contrast} argument which has two elements:
+the names of the log2 fold changes to add, and the names of the log2
+fold changes to subtract. The names used in the list should come from
+\Robject{resultsNames(dds)}.
+
+Alternatively, a numeric vector of the
+length of \Robject{resultsNames(dds)} can be provided, for manually
+specifying the linear combination of terms. Demonstrations of the use
+of contrasts for various designs can be found in the examples section
+of the help page for the \Rfunction{results} function. The
+mathematical formula that is used to generate the contrasts can be found in
+Section~\ref{sec:ctrstTheory}.
+
+\subsection{Interactions} \label{sec:interactions}
+
+Interaction terms can be added to the design formula, in order to
+test, for example, if the log2 fold change attributable to a given
+condition is \textit{different} based on another factor, for example if the
+condition effect differs across genotype.
+
+Many users begin to add interaction terms to the design formula, when
+in fact a much simpler approach would give all the results tables that
+are desired. We will explain this approach first, because it is much
+simpler to perform.
+If the comparisons of interest are, for example, the effect
+of a condition for different sets of samples, a simpler approach than
+adding interaction terms explicitly to the design formula is to
+perform the following steps:
+
+\begin{enumerate}
+\item combine the factors of interest into a single factor with all
+ combinations of the original factors
+\item change the design to include just this factor, e.g. \Robject{\lowtilde{} group}
+\end{enumerate}
+
+Using this design is similar to adding an interaction term,
+in that it models multiple condition effects which
+can be easily extracted with \Rfunction{results}.
+Suppose we have two factors \Robject{genotype} (with values I, II, and III)
+and \Robject{condition} (with values A and B), and we want to extract
+the condition effect specifically for each genotype. We could use the
+following approach to obtain, e.g. the condition effect for genotype I:
+
+<<combineFactors, eval=FALSE>>=
+dds$group <- factor(paste0(dds$genotype, dds$condition))
+design(dds) <- ~ group
+dds <- DESeq(dds)
+resultsNames(dds)
+results(dds, contrast=c("group", "IB", "IA"))
+@
+
+<<interFig, dev="pdf", fig.width=4, fig.height=3, echo=FALSE, results="hide">>=
+npg <- 20
+mu <- 2^c(8,10,9,11,10,12)
+cond <- rep(rep(c("A","B"),each=npg),3)
+geno <- rep(c("I","II","III"),each=2*npg)
+table(cond, geno)
+counts <- rnbinom(6*npg, mu=rep(mu,each=npg), size=1/.01)
+d <- data.frame(log2c=log2(counts+1), cond, geno)
+library(ggplot2)
+plotit <- function(d, title) {
+ ggplot(d, aes(x=cond, y=log2c, group=geno)) +
+ geom_jitter(size=1.5, position = position_jitter(width=.15)) +
+ facet_wrap(~ geno) +
+ stat_summary(fun.y=mean, geom="line", colour="red", size=0.8) +
+ xlab("condition") + ylab("log2(counts+1)") + ggtitle(title)
+}
+plotit(d, "Gene 1") + ylim(7,13)
+lm(log2c ~ cond + geno + geno:cond, data=d)
+@
+
+<<interFig2, dev="pdf", fig.width=4, fig.height=3, echo=FALSE, results="hide">>=
+mu[4] <- 2^12
+mu[6] <- 2^8
+counts <- rnbinom(6*npg, mu=rep(mu,each=npg), size=1/.01)
+d2 <- data.frame(log2c=log2(counts + 1), cond, geno)
+plotit(d2, "Gene 2") + ylim(7,13)
+lm(log2c ~ cond + geno + geno:cond, data=d2)
+@
+
+\begin{figure}
+\centering
+\includegraphics[width=.49\textwidth]{figure/interFig-1}
+\includegraphics[width=.49\textwidth]{figure/interFig2-1}
+\caption{
+ \textbf{Genotype-specific condition effects.}
+ Here, the y-axis represents $\log_2(\textrm{counts}+1)$, and each
+ group has 20 samples (black dots). A red line connects the mean of
+ the groups within each genotype.
+ On the left side (Gene 1), note that the condition effect is consistent
+ across genotypes. Although condition A has a different baseline for
+ I,II, and III, the condition effect is a log2 fold change of about 2
+ for each genotype.
+ Using a model with an interaction term \Robject{genotype:condition},
+ the interaction terms for genotype II and genotype III will be nearly 0.
+ On the right side (Gene 2), we can see that the condition effect is
+ not consistent across genotype. Here the main condition effect (the
+ effect for the reference genotype I) is again 2. However, this time
+ the interaction terms will be around 1 for genotype II and
+ -4 for genotype III. This is
+ because the condition effect is higher by 1 for genotype II compared to
+ genotype I, and lower by 4 for genotype III compared to genotype I.
+ The condition effect for genotype II (or III) is obtained by adding the
+ main condition effect and the interaction term for that genotype.
+ Such a plot can be made using the \Rfunction{plotCounts} function
+ (Section~\ref{sec:plotcounts}).
+}
+\label{fig:inter}
+\end{figure}
+
+Now we will continue to explain the use of interactions in order to
+test for \textit{differences} in condition effects. We continue with
+the example of condition effects across three genotypes (I, II, and III).
+For a diagram of how interactions might look across genotypes
+please refer to Figure \ref{fig:inter}.
+
+The key point to remember about designs with interaction terms is
+that, unlike for a design \Robject{\lowtilde{}
+ genotype + condition}, where the condition effect represents the
+\textit{overall} effect controlling for differences due to genotype, by adding
+\Robject{genotype:condition}, the main condition effect only
+represents the effect of condition for the \textit{reference level} of
+genotype (I, or whichever level was defined by the user as the
+reference level). The interaction terms \Robject{genotypeII.conditionB}
+and \Robject{genotypeIII.conditionB} give the \textit{difference}
+between the condition effect for a given genotype and the condition
+effect for the reference genotype.
+
+This genotype-condition interaction example is examined in further
+detail in Example 3 in the help page for \Rfunction{results}, which
+can be found by typing \Rcode{?results}. In particular, we show how to
+test for differences in the condition effect across genotype, and we
+show how to obtain the condition effect for non-reference genotypes.
+Note that in \deseqtwo{} version 1.10, the \Rfunction{DESeq} function will turn
+off log fold change shrinkage (setting \Robject{betaPrior=FALSE}),
+for designs which contain an interaction term. Turning off the log
+fold change shrinkage allows the software to use standard model
+matrices (as would be produced by \Rfunction{model.matrix}), where the
+interaction coefficients are easier to interpret.
+
+\subsection{Time-series experiments}
+
+There are a number of ways to analyze time-series experiments,
+depending on the biological question of interest. In order to test for
+any differences over multiple time points, once can use a design
+including the time factor, and then test using the likelihood ratio
+test as described in Section~\ref{sec:LRT}, where the time factor is
+removed in the reduced formula. For a control and treatment time
+series, one can use a design formula containing the condition factor,
+the time factor, and the interaction of the two. In this case, using
+the likelihood ratio test with a reduced model which does not contain
+the interaction terms will test whether the condition induces a change
+in gene expression at any time point after the reference level time point
+(time 0). An example of the later analysis is provided in an RNA-seq
+workflow on the Bioconductor
+website: \url{http://www.bioconductor.org/help/workflows/rnaseqGene/}.
+
+\subsection{Likelihood ratio test} \label{sec:LRT}
+
+\deseqtwo{} offers two kinds of hypothesis tests: the Wald test, where
+we use the estimated standard error of a log2 fold change to test if it is
+equal to zero, and the likelihood ratio test (LRT). The LRT examines
+two models for the counts, a \emph{full} model with a certain number
+of terms and a \emph{reduced} model, in which some of the terms of the
+\emph{full} model are removed. The test determines if the increased
+likelihood of the data using the extra terms in the \emph{full} model
+is more than expected if those extra terms are truly zero.
+
+The LRT is therefore useful for testing multiple
+terms at once, for example testing 3 or more levels of a factor at once,
+or all interactions between two variables.
+The LRT for count data is conceptually similar to an analysis of variance (ANOVA)
+calculation in linear regression, except that in the case of the Negative
+Binomial GLM, we use an analysis of deviance (ANODEV), where the
+\emph{deviance} captures the difference in likelihood between a full
+and a reduced model.
+
+The likelihood ratio test can be specified using the \Robject{test}
+argument to \Rfunction{DESeq}, which substitutes
+\Rfunction{nbinomWaldTest} with \Rfunction{nbinomLRT}. In this case,
+the user needs to provide a reduced formula, e.g. one in which a
+number of terms from \Robject{design(dds)} are removed.
+The degrees of freedom for the test is obtained from the difference
+between the number of parameters in the two models.
+
+\subsection{Approach to count outliers} \label{sec:outlierApproach}
+
+RNA-seq data sometimes contain isolated instances of very large counts that are apparently
+unrelated to the experimental or study design, and which may be
+considered outliers. There are many reasons why outliers can arise, including rare
+technical or experimental artifacts, read mapping problems in the case of genetically
+differing samples, and genuine, but rare biological events. In many cases, users appear
+primarily interested in genes that show a consistent behavior, and this is the reason why
+by default, genes that are affected by such outliers are set aside by \deseqtwo{},
+or if there are sufficient samples, outlier counts are replaced for model fitting.
+These two behaviors are described below.
+
+The \Rfunction{DESeq} function calculates, for every gene and for every sample,
+a diagnostic test for outliers called \emph{Cook's distance}. Cook's distance
+is a measure of how much a single sample is influencing the fitted
+coefficients for a gene, and a large value of Cook's distance is
+intended to indicate an outlier count.
+The Cook's distances are stored as a matrix available in
+\Robject{assays(dds)[["cooks"]]}.
+
+The \Rfunction{results} function automatically flags genes which contain a
+Cook's distance above a cutoff for samples which have 3 or more replicates.
+The $p$ values and adjusted $p$ values for these genes are set to \Robject{NA}.
+At least 3 replicates are required for flagging, as it is difficult to judge
+which sample might be an outlier with only 2 replicates.
+This filtering can be turned off with \Rcode{results(dds, cooksCutoff=FALSE)}.
+
+With many degrees of freedom -- i.\,e., many more samples than number of parameters to
+be estimated -- it is undesirable to remove entire genes from the analysis
+just because their data include a single count outlier. When there
+are 7 or more replicates for a given sample, the \Rfunction{DESeq}
+function will automatically replace counts with large Cook's distance
+with the trimmed mean over all samples, scaled up by the size factor or
+normalization factor for that sample. This approach is conservative,
+it will not lead to false positives, as it replaces
+the outlier value with the value predicted by the null hypothesis.
+This outlier replacement only occurs when there are 7 or more
+replicates, and can be turned off with
+\Rcode{DESeq(dds, minReplicatesForReplace=Inf)}.
+
+The default Cook's distance cutoff for the two behaviors described above
+depends on the sample size and number of parameters
+to be estimated. The default is to use the $99\%$ quantile of the
+$F(p,m-p)$ distribution (with $p$ the number of parameters including the
+intercept and $m$ number of samples).
+The default for gene flagging can be modified using the \Robject{cooksCutoff}
+argument to the \Rfunction{results} function.
+For outlier replacement, \Rfunction{DESeq} preserves the original counts in
+\Robject{counts(dds)} saving the replacement counts as a matrix named
+\Robject{replaceCounts} in \Robject{assays(dds)}.
+Note that with continuous variables in the design, outlier detection
+and replacement is not automatically performed, as our
+current methods involve a robust estimation of within-group variance
+which does not extend easily to continuous covariates. However, users
+can examine the Cook's distances in \Rcode{assays(dds)[["cooks"]]}, in
+order to perform manual visualization and filtering if necessary.
+
+\textbf{Note on many outliers:} if there are very many outliers
+(e.g. many hundreds or thousands) reported by
+\Rcode{summary(res)}, one might consider further exploration to see if
+a single sample or a few samples should be removed due to low quality.
+The automatic outlier filtering/replacement is most useful in situations which the number
+of outliers is limited. When there are thousands of reported outliers,
+it might make more sense to turn off the outlier filtering/replacement
+(\Rfunction{DESeq} with \Robject{minReplicatesForReplace=Inf} and
+\Rfunction{results} with \Robject{cooksCutoff=FALSE})
+and perform manual inspection: First it would be
+advantageous to make a PCA plot using the code example in Section
+\ref{sec:pca} to spot individual sample outliers; Second, one can make
+a boxplot of the Cook's distances to see if one sample is consistently
+higher than others:
+
+<<boxplotCooks>>=
+par(mar=c(8,5,2,2))
+boxplot(log10(assays(dds)[["cooks"]]), range=0, las=2)
+@
+
+\incfig{figure/boxplotCooks-1}{.5\textwidth}{Boxplot of Cook's distances.}{
+ Here we can look to see if one sample has much higher Cook's distances
+ than the other samples. In this case, the samples all have
+ comparable range of Cook's distances.
+}
+
+\subsection{Dispersion plot and fitting alternatives}
+
+Plotting the dispersion estimates is a useful diagnostic. The dispersion
+plot in Figure \ref{figure/dispFit-1} is typical, with the final estimates shrunk
+from the gene-wise estimates towards the fitted estimates. Some gene-wise
+estimates are flagged as outliers and not shrunk towards the fitted value,
+(this outlier detection is described in the man page for \Rfunction{estimateDispersionsMAP}).
+The amount of shrinkage can be more or less than seen here, depending
+on the sample size, the number of coefficients, the row mean
+and the variability of the gene-wise estimates.
+
+<<dispFit>>=
+plotDispEsts(dds)
+@
+
+\incfig{figure/dispFit-1}{.5\textwidth}{Dispersion plot.}{
+ The dispersion estimate plot shows the gene-wise estimates (black),
+ the fitted values (red), and the final maximum \textit{a posteriori}
+ estimates used in testing (blue).
+}
+
+\subsubsection{Local or mean dispersion fit}
+
+A local smoothed dispersion fit is automatically substitited in the case that
+the parametric curve doesn't fit the observed dispersion mean relationship.
+This can be prespecified by providing the argument
+\Robject{fitType="local"} to either \Rfunction{DESeq} or \Rfunction{estimateDispersions}.
+Additionally, using the mean of gene-wise disperion estimates as the
+fitted value can be specified by providing the argument \Robject{fitType="mean"}.
+
+\subsubsection{Supply a custom dispersion fit}
+
+Any fitted values can be provided during dispersion estimation, using
+the lower-level functions described in the manual page for
+\Rfunction{estimateDispersionsGeneEst}. In the code chunk below, we
+store the gene-wise estimates which were already calculated and saved
+in the metadata column \Robject{dispGeneEst}. Then we calculate the
+median value of the dispersion estimates above a threshold, and save
+these values as the fitted dispersions, using the replacement function
+for \Rfunction{dispersionFunction}. In the last line, the function
+\Rfunction{estimateDispersionsMAP}, uses the
+fitted dispersions to generate maximum \textit{a posteriori} (MAP)
+estimates of dispersion.
+
+<<dispFitCustom>>=
+ddsCustom <- dds
+useForMedian <- mcols(ddsCustom)$dispGeneEst > 1e-7
+medianDisp <- median(mcols(ddsCustom)$dispGeneEst[useForMedian],na.rm=TRUE)
+dispersionFunction(ddsCustom) <- function(mu) medianDisp
+ddsCustom <- estimateDispersionsMAP(ddsCustom)
+@
+
+
+\subsection{Independent filtering of results}\label{sec:autoFilt}
+
+The \Rfunction{results} function of the \deseqtwo{} package
+performs independent filtering by default using
+the mean of normalized counts as a filter statistic.
+A threshold on the filter statistic is found which optimizes the number
+of adjusted $p$ values lower than a significance level \Robject{alpha}
+(we use the standard variable name for significance level,
+though it is unrelated to the dispersion parameter $\alpha$).
+The theory behind independent filtering is discussed in greater detail
+in Section~\ref{sec:indepfilt}. The adjusted $p$ values for the genes
+which do not pass the filter threshold are set to \Robject{NA}.
+
+The independent filtering is performed using the \Rfunction{filtered\_p} function
+of the \Biocpkg{genefilter} package, and all of the arguments of \Rfunction{filtered\_p}
+can be passed to the \Rfunction{results} function.
+The filter threshold value and the number of rejections at each quantile
+of the filter statistic are available as metadata of the object
+returned by \Rfunction{results}. For example, we can visualize
+the optimization by plotting the \Robject{filterNumRej} attribute of
+the results object, as seen in Figure \ref{figure/filtByMean-1}.
+
+<<filtByMean, dev="pdf">>=
+metadata(res)$alpha
+metadata(res)$filterThreshold
+plot(metadata(res)$filterNumRej,
+ type="b", ylab="number of rejections",
+ xlab="quantiles of filter")
+lines(metadata(res)$lo.fit, col="red")
+abline(v=metadata(res)$filterTheta)
+@
+
+\incfig{figure/filtByMean-1}{.5\textwidth}{Independent filtering.}{
+ The \Rfunction{results} function maximizes the
+ number of rejections (adjusted $p$ value less than a
+ significance level), over the quantiles
+ of a filter statistic (the mean of normalized counts).
+ The threshold chosen (vertical line) is
+ the lowest quantile of the filter for which the
+ number of rejections is within 1 residual standard deviation to the
+ peak of a curve fit
+ to the number of rejections over the filter quantiles.
+}
+
+Independent filtering can be turned off by setting
+\Robject{independentFiltering} to \Robject{FALSE}.
+
+<<noFilt>>=
+resNoFilt <- results(dds, independentFiltering=FALSE)
+addmargins(table(filtering=(res$padj < .1), noFiltering=(resNoFilt$padj < .1)))
+@
+
+\subsection{Tests of log2 fold change above or below a threshold}
+
+It is also possible to provide thresholds for constructing
+Wald tests of significance. Two arguments to the \Rfunction{results}
+function allow for threshold-based Wald tests: \Robject{lfcThreshold},
+which takes a numeric of a non-negative threshold value,
+and \Robject{altHypothesis}, which specifies the kind of test.
+Note that the \textit{alternative hypothesis} is specified by the user,
+i.e. those genes which the user is interested in finding, and the test
+provides $p$ values for the null hypothesis, the complement of the set
+defined by the alternative. The \Robject{altHypothesis} argument can take one
+of the following four values, where $\beta$ is the log2 fold change
+specified by the \Robject{name} argument:
+
+\begin{itemize}
+ \item \Robject{greaterAbs} - $|\beta| > \textrm{lfcThreshold}$ - tests are two-tailed
+ \item \Robject{lessAbs} - $|\beta| < \textrm{lfcThreshold}$ - $p$ values are the maximum of the upper and lower tests
+ \item \Robject{greater} - $\beta > \textrm{lfcThreshold} $
+ \item \Robject{less} - $\beta < -\textrm{lfcThreshold} $
+\end{itemize}
+
+The test \Robject{altHypothesis="lessAbs"} requires that the user have
+run \Rfunction{DESeq} with the argument \Robject{betaPrior=FALSE}. To
+understand the reason for this requirement, consider that during
+hypothesis testing, the null hypothesis is favored unless the data
+provide strong evidence to reject the null. For this test, including
+a zero-centered prior on log fold change would favor the alternative
+hypothesis, shrinking log fold changes toward zero. Removing the
+prior on log fold changes for tests of small log fold change allows
+for detection of only those genes where the data alone provides
+evidence against the null.
+
+The four possible values of \Robject{altHypothesis} are demonstrated
+in the following code and visually by MA-plots in Figure~\ref{figure/lfcThresh-1}.
+First we run \Rfunction{DESeq} and specify \Robject{betaPrior=FALSE} in order
+to demonstrate \Robject{altHypothesis="lessAbs"}.
+
+<<ddsNoPrior>>=
+ddsNoPrior <- DESeq(dds, betaPrior=FALSE)
+@
+
+In order to produce results tables for the following tests, the same arguments
+(except \Robject{ylim}) would be provided to the \Rfunction{results} function.
+
+<<lfcThresh>>=
+par(mfrow=c(2,2),mar=c(2,2,1,1))
+yl <- c(-2.5,2.5)
+
+resGA <- results(dds, lfcThreshold=.5, altHypothesis="greaterAbs")
+resLA <- results(ddsNoPrior, lfcThreshold=.5, altHypothesis="lessAbs")
+resG <- results(dds, lfcThreshold=.5, altHypothesis="greater")
+resL <- results(dds, lfcThreshold=.5, altHypothesis="less")
+
+plotMA(resGA, ylim=yl)
+abline(h=c(-.5,.5),col="dodgerblue",lwd=2)
+plotMA(resLA, ylim=yl)
+abline(h=c(-.5,.5),col="dodgerblue",lwd=2)
+plotMA(resG, ylim=yl)
+abline(h=.5,col="dodgerblue",lwd=2)
+plotMA(resL, ylim=yl)
+abline(h=-.5,col="dodgerblue",lwd=2)
+@
+
+\incfig{figure/lfcThresh-1}{.5\textwidth}{MA-plots of tests of log2 fold
+ change with respect to a threshold value.}{
+ Going left to right across rows, the tests are for \Robject{altHypothesis = "greaterAbs"},
+ \Robject{"lessAbs"}, \Robject{"greater"}, and \Robject{"less"}.
+}
+
+\subsection{Access to all calculated values}\label{sec:access}
+
+All row-wise calculated values (intermediate dispersion calculations,
+coefficients, standard errors, etc.) are stored in the \Rclass{DESeqDataSet}
+object, e.g. \Robject{dds} in this vignette. These values are accessible
+by calling \Rfunction{mcols} on \Robject{dds}.
+Descriptions of the columns are accessible by two calls to
+\Rfunction{mcols}.
+
+<<mcols>>=
+mcols(dds,use.names=TRUE)[1:4,1:4]
+# here using substr() only for display purposes
+substr(names(mcols(dds)),1,10)
+mcols(mcols(dds), use.names=TRUE)[1:4,]
+@
+
+The mean values $\mu_{ij} = s_j q_{ij}$ and the Cook's distances for each gene and
+sample are stored as matrices in the assays slot:
+
+<<muAndCooks>>=
+head(assays(dds)[["mu"]])
+head(assays(dds)[["cooks"]])
+@
+
+The dispersions $\alpha_i$ can be accessed with the
+\Rfunction{dispersions} function.
+
+<<dispersions>>=
+head(dispersions(dds))
+# which is the same as
+head(mcols(dds)$dispersion)
+@
+
+The size factors $s_j$ are accessible via \Rfunction{sizeFactors}:
+
+<<sizefactors>>=
+sizeFactors(dds)
+@
+
+For advanced users, we also include a convenience function \Rfunction{coef} for
+extracting the matrix of coefficients $[\beta_{ir}]$ for all genes $i$ and
+parameters $r$, as in the formula in Section~\ref{sec:glm}.
+This function can also return a matrix of standard errors, see \Robject{?coef}.
+The columns of this matrix correspond to the effects returned by \Rfunction{resultsNames}.
+Note that the \Rfunction{results} function is best for building
+results tables with $p$ values and adjusted $p$ values.
+
+<<coef>>=
+head(coef(dds))
+@
+
+The beta prior variance $\sigma_r^2$ is stored as an attribute of the
+\Rclass{DESeqDataSet}:
+
+<<betaPriorVar>>=
+attr(dds, "betaPriorVar")
+@
+
+The dispersion prior variance $\sigma_d^2$ is stored as an
+attribute of the dispersion function:
+
+<<dispPriorVar>>=
+dispersionFunction(dds)
+attr(dispersionFunction(dds), "dispPriorVar")
+@
+
+\subsection{Sample-/gene-dependent normalization factors} \label{sec:normfactors}
+
+In some experiments, there might be gene-dependent dependencies
+which vary across samples. For instance, GC-content bias or length
+bias might vary across samples coming from different labs or
+processed at different times. We use the terms ``normalization factors''
+for a gene $\times$ sample matrix, and ``size factors'' for a
+single number per sample. Incorporating normalization factors,
+the mean parameter $\mu_{ij}$ from Section~\ref{sec:glm} becomes:
+
+$$ \mu_{ij} = NF_{ij} q_{ij} $$
+
+with normalization factor matrix $NF$ having the same dimensions
+as the counts matrix $K$. This matrix can be incorporated as shown
+below. We recommend providing a matrix with row-wise geometric means of $1$,
+so that the mean of normalized counts for a gene is close to the mean
+of the unnormalized counts.
+This can be accomplished by dividing out the current row geometric means.
+
+<<normFactors, eval=FALSE>>=
+normFactors <- normFactors / exp(rowMeans(log(normFactors)))
+normalizationFactors(dds) <- normFactors
+@
+
+These steps then replace \Rfunction{estimateSizeFactors} in the steps
+described in Section~\ref{sec:steps}. Normalization factors, if present,
+will always be used in the place of size factors.
+
+The methods provided by the \Biocpkg{cqn} or \Biocpkg{EDASeq} packages
+can help correct for GC or length biases. They both describe in their
+vignettes how to create matrices which can be used by \deseqtwo{}.
+From the formula above, we see that normalization factors should be on
+the scale of the counts, like size factors, and unlike offsets which
+are typically on the scale of the predictors (i.e. the logarithmic scale for
+the negative binomial GLM). At the time of writing, the transformation
+from the matrices provided by these packages should be:
+
+<<offsetTransform, eval=FALSE>>=
+cqnOffset <- cqnObject$glm.offset
+cqnNormFactors <- exp(cqnOffset)
+EDASeqNormFactors <- exp(-1 * EDASeqOffset)
+@
+
+\subsection{``Model matrix not full rank''}
+
+While most experimental designs run easily using design formula, some
+design formulas can cause problems and result in the \Rfunction{DESeq}
+function returning an error with the text: ``the model matrix is not
+full rank, so the model cannot be fit as specified.'' There are two
+main reasons for this problem: either one or more columns in the model
+matrix are linear combinations of other columns, or there are levels
+of factors or combinations of levels of multiple factors which are
+missing samples. We address these two problems below and discuss
+possible solutions:
+
+\subsubsection{Linear combinations}
+
+The simplest case is the linear combination, or linear dependency
+problem, when two variables contain exactly the same information, such
+as in the following sample table. The software cannot fit an effect
+for \Robject{batch} and \Robject{condition}, because they produce
+identical columns in the model matrix. This is also referred to as
+``perfect confounding''. A unique solution of coefficients (the $\beta_i$ in
+the formula in Section~\ref{sec:glm}) is not possible.
+
+<<lineardep, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,2,2)), condition=factor(c("A","A","B","B")))
+@
+
+Another situation which will cause problems is when the variables are
+not identical, but one variable can be formed by the combination of
+other factor levels. In the following example, the effect of batch 2
+vs 1 cannot be fit because it is identical to a column in the model
+matrix which represents the condition C vs A effect.
+
+<<lineardep2, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,1,1,2,2)), condition=factor(c("A","A","B","B","C","C")))
+@
+
+In both of these cases above, the batch effect cannot be fit and must
+be removed from the model formula. There is just no way to tell apart
+the condition effects and the batch effects. The options are either to assume
+there is no batch effect (which we know is highly unlikely given the
+literature on batch effects in sequencing datasets) or to repeat the
+experiment and properly balance the conditions across batches.
+A balanced design would look like:
+
+<<lineardep3, echo=FALSE>>=
+data.frame(batch=factor(c(1,1,1,2,2,2)), condition=factor(c("A","B","C","A","B","C")))
+@
+
+Finally, there is a case where we can in fact perform inference.
+Consider an experiment with grouped individuals,
+where we seek to test the group-specific effect of a treatment, while
+controlling for individual effects. A simple example of such a design is:
+
+<<groupeffect>>=
+(coldata <- data.frame(grp=factor(rep(c("X","Y"),each=4)),
+ ind=factor(rep(1:4,each=2)),
+ cnd=factor(rep(c("A","B"),4))))
+@
+
+
+This design can be analyzed by \deseqtwo{} but requires a bit of
+refactoring in order to fit the model terms. Here we will use a trick
+described in the \Biocpkg{edgeR} user guide, from the section
+``Comparisons Both Between and Within Subjects''. If we try to
+analyze with a formula such as, \Rcode{$\sim$ ind + grp*cnd}, we will
+obtain an error, because the effect for group is a linear combination
+of the individuals.
+
+However, the following steps allow for an analysis of group-specific
+condition effects, while controlling for differences in individual.
+For object construction, use a dummy design, such as \Rcode{$\sim$
+ 1}. Then add a column \Robject{ind.n} which distinguishes the
+individuals ``nested'' within a group. Here, we add this column to
+coldata, but in practice you would add this column to \Rcode{dds}.
+
+<<groupeffect2>>=
+coldata$ind.n <- factor(rep(rep(1:2,each=2),2))
+coldata
+@
+
+Now we can reassign our \Rclass{DESeqDataSet} a design of
+\Rcode{$\sim$ grp + grp:ind.n + grp:cnd}, before we call
+\Rfunction{DESeq}. This new design will result in the following model
+matrix:
+
+<<groupeffect3>>=
+model.matrix(~ grp + grp:ind.n + grp:cnd, coldata)
+@
+
+where the terms \Robject{grpX.cndB} and \Robject{grpY.cndB} give the
+group-specific condition effects. These can be extracted using
+\Rfunction{results} with the \Robject{name} argument.
+Furthermore, \Robject{grpX.cndB} and
+\Robject{grpY.cndB} can be contrasted using the \Robject{contrast}
+argument, in order to test if the condition effect is different across group:
+
+<<groupeffect4, eval=FALSE>>=
+results(dds, contrast=list("grpY.cndB","grpX.cndB"))
+@
+
+\subsubsection{Levels without samples}
+
+The base R function for creating model matrices will produce a column
+of zeros if a level is missing from a factor or a combination of
+levels is missing from an interaction of factors. The solution to the
+first case is to call \Rfunction{droplevels} on the column, which will
+remove levels without samples. This was shown in the beginning of this
+vignette.
+
+The second case is also solvable, by manually editing the model
+matrix, and then providing this to \Rfunction{DESeq}. Here we
+construct an example dataset to illustrate:
+
+<<missingcombo>>=
+group <- factor(rep(1:3,each=6))
+condition <- factor(rep(rep(c("A","B","C"),each=2),3))
+(d <- data.frame(group, condition)[-c(17,18),])
+@
+
+Note that if we try to estimate all interaction terms, we introduce a
+column with all zeros, as there are no condition C samples for group
+3. (Here, \Rfunction{unname} is used to display the matrix concisely.)
+
+<<missingcombo2>>=
+m1 <- model.matrix(~ condition*group, d)
+colnames(m1)
+unname(m1)
+@
+
+We can remove this column like so:
+
+<<missingcombo3>>=
+m1 <- m1[,-9]
+unname(m1)
+@
+
+Now this matrix \Robject{m1} can be provided to the \Robject{full}
+argument of \Rfunction{DESeq}. For a likelihood ratio test of
+interactions, a model matrix using a reduced design such as
+\Rcode{$\sim$ condition + group} can be given to the \Robject{reduced}
+argument. Wald tests can also be generated instead of the likelihood
+ratio test, but for user-supplied model matrices, the argument
+\Robject{betaPrior} must be set to \Robject{FALSE}.
+
+\newpage
+
+%--------------------------------------------------
+\section{Theory behind DESeq2}
+%--------------------------------------------------
+
+\subsection{The DESeq2 model} \label{sec:glm}
+
+The \deseqtwo{} model and all the steps taken in the software
+are described in detail in our publication \cite{Love2014},
+and we include the formula and descriptions in this section as well.
+The differential expression analysis in \deseqtwo{} uses a generalized
+linear model of the form:
+
+$$ K_{ij} \sim \textrm{NB}(\mu_{ij}, \alpha_i) $$
+$$ \mu_{ij} = s_j q_{ij} $$
+$$ \log_2(q_{ij}) = x_{j.} \beta_i $$
+
+where counts $K_{ij}$ for gene $i$, sample $j$ are modeled using
+a negative binomial distribution with fitted mean $\mu_{ij}$
+and a gene-specific dispersion parameter $\alpha_i$.
+The fitted mean is composed of a sample-specific size factor
+$s_j$\footnote{The model can be generalized to use sample-
+\textbf{and} gene-dependent normalization factors, see
+Appendix~\ref{sec:normfactors}.} and a parameter $q_{ij}$
+proportional to the expected true concentration of fragments for sample $j$.
+The coefficients $\beta_i$ give the log2 fold changes for gene $i$ for each
+column of the model matrix $X$.
+
+By default these log2 fold changes are the maximum \emph{a posteriori} estimates after incorporating a
+zero-centered Normal prior -- in the software referrred to as a $\beta$-prior -- hence \deseqtwo{}
+provides ``moderated'' log2 fold change estimates. Dispersions are estimated using expected mean
+values from the maximum likelihood estimate of log2 fold changes, and optimizing the Cox-Reid
+adjusted profile likelihood, as first implemented for RNA-seq data in \Biocpkg{edgeR}
+\cite{CR,edgeR_GLM}. The steps performed by the \Rfunction{DESeq} function are documented in its
+manual page; briefly, they are:
+
+\begin{enumerate}
+\item estimation of size factors $s_j$ by \Rfunction{estimateSizeFactors}
+\item estimation of dispersion $\alpha_i$ by \Rfunction{estimateDispersions}
+\item negative binomial GLM fitting for $\beta_i$ and Wald statistics by
+\Rfunction{nbinomWaldTest}
+\end{enumerate}
+
+For access to all the values calculated during these steps,
+see Section~\ref{sec:access}
+
+\subsection{Changes compared to the \Biocpkg{DESeq} package}
+
+The main changes in the package \deseqtwo{}, compared to the (older)
+version \Biocpkg{DESeq}, are as follows:
+
+\begin{itemize}
+\item \Rclass{RangedSummarizedExperiment} is used as the superclass for storage of input data,
+ intermediate calculations and results.
+\item Maximum \textit{a posteriori} estimation of GLM coefficients
+ incorporating a zero-centered
+ Normal prior with variance estimated from data (equivalent to Tikhonov/ridge
+ regularization). This adjustment has little effect on genes with high counts, yet it
+ helps to moderate the otherwise large variance in log2 fold change estimates
+ for genes with low counts or highly variable counts.
+\item Maximum \textit{a posteriori} estimation of dispersion replaces the
+ \Robject{sharingMode} options \Robject{fit-only} or \Robject{maximum} of the previous version
+ of the package. This is similar to the dispersion estimation methods of DSS \cite{Wu2012New}.
+\item All estimation and inference is based on the generalized linear model, which
+ includes the two condition case (previously the \textit{exact test} was used).
+\item The Wald test for significance of GLM coefficients is provided as the default
+ inference method, with the likelihood ratio test of the previous version still available.
+\item It is possible to provide a matrix of sample-/gene-dependent
+ normalization factors (Section \ref{sec:normfactors}).
+\item Automatic independent filtering on the mean of normalized counts
+ (Section \ref{sec:indepfilt}).
+\item Automatic outlier detection and handling (Section \ref{sec:cooks}).
+\end{itemize}
+
+\subsection{Methods changes since the 2014 DESeq2 paper}
+
+\begin{itemize}
+ \item For the calculation of the beta prior variance, instead of
+ matching the empirical quantile to the quantile of a Normal
+ distribution, \deseqtwo() now uses the weighted quantile function
+ of the \CRANpkg{Hmisc} package. The weighting is described in the
+ man page for \Rfunction{nbinomWaldTest}. The weights are the
+ inverse of the expected variance of log counts (as used in the
+ diagonals of the matrix $W$ in the GLM). The effect of the change
+ is that the estimated prior variance is robust against noisy
+ estimates of log fold change from genes with very small
+ counts. This change was introduced in version 1.6 (October 2014).
+ \item For designs with interaction terms, the solution described in
+ the paper is no longer used (log fold change shrinkage only
+ applied to interaction terms). Instead, \deseqtwo{} now turns off
+ log fold change shrinkage for all terms if an interaction term is
+ present (\Robject{betaPrior=FALSE}). While the inference on
+ interaction terms was correct with \Robject{betaPrior=TRUE}, the
+ interpretation of the individual terms and the extraction of
+ contrasts was too confusing. This change was introduced in version 1.10
+ (October 2015).
+ \item A small change to the independent filtering routine: instead
+ of taking the quantile of the filter (the mean of normalized counts) which
+ directly \textit{maximizes} the number of rejections, the threshold chosen is
+ the lowest quantile of the filter for which the
+ number of rejections is close to the peak of a curve fit
+ to the number of rejections over the filter quantiles.
+ ``Close to'' is defined as within 1 residual standard deviation.
+ This change was introduced in version 1.10 (October 2015).
+\end{itemize}
+
+For a list of all changes since version 1.0.0, see the NEWS file
+included in the package.
+
+\subsection{Count outlier detection} \label{sec:cooks}
+
+\deseqtwo{} relies on the negative binomial distribution to make
+estimates and perform statistical inference on differences. While the
+negative binomial is versatile in having a mean and dispersion
+parameter, extreme counts in individual samples might not fit well to
+the negative binomial. For this reason, we perform automatic detection
+of count outliers. We use Cook's distance, which is a measure of how
+much the fitted coefficients would change if an individual sample were
+removed \cite{Cook1977Detection}. For more on the implementation of
+Cook's distance see Section~\ref{sec:outlierApproach} and the manual page
+for the \Rfunction{results} function. Below we plot the maximum value of
+Cook's distance for each row over the rank of the test statistic
+to justify its use as a filtering criterion.
+
+<<cooksPlot>>=
+W <- res$stat
+maxCooks <- apply(assays(dds)[["cooks"]],1,max)
+idx <- !is.na(W)
+plot(rank(W[idx]), maxCooks[idx], xlab="rank of Wald statistic",
+ ylab="maximum Cook's distance per gene",
+ ylim=c(0,5), cex=.4, col=rgb(0,0,0,.3))
+m <- ncol(dds)
+p <- 3
+abline(h=qf(.99, p, m - p))
+@
+
+\incfig{figure/cooksPlot-1}{.5\textwidth}{Cook's distance.}{
+ Plot of the maximum Cook's distance per gene over the rank of
+ the Wald statistics for the condition. The two regions with small Cook's
+ distances are genes with a single count in one sample. The horizontal
+ line is the default cutoff used for 7 samples and 3 estimated parameters.
+}
+
+\subsection{Contrasts} \label{sec:ctrstTheory}
+
+Contrasts can be calculated for a \Rclass{DESeqDataSet} object for which
+the GLM coefficients have already been fit using the Wald test steps
+(\Rfunction{DESeq} with \texttt{test="Wald"} or using \Rfunction{nbinomWaldTest}).
+The vector of coefficients $\beta$ is left multiplied by the contrast vector $c$
+to form the numerator of the test statistic. The denominator is formed by multiplying
+the covariance matrix $\Sigma$ for the coefficients on either side by the
+contrast vector $c$. The square root of this product is an estimate
+of the standard error for the contrast. The contrast statistic is then compared
+to a normal distribution as are the Wald statistics for the \deseqtwo{}
+package.
+
+$$ W = \frac{c^t \beta}{\sqrt{c^t \Sigma c}} $$
+
+\subsection{Expanded model matrices} \label{sec:expanded}
+
+\deseqtwo{} uses ``expanded model matrices'' with the log2 fold change prior,
+in order to produce shrunken log2 fold change estimates and test
+results which are independent of the choice of reference level.
+Another way of saying this is that the shrinkage is \textit{symmetric}
+with respect to all the levels of the factors in the design.
+The expanded model matrices differ from the standard model matrices, in that
+they have an indicator column (and therefore a coefficient) for
+each level of factors in the design formula in addition to an intercept.
+Note that in version 1.10 and onward, standard model matrices are used for
+designs with interaction terms, as the shrinkage of log2 fold changes
+is not recommended for these designs.
+
+The expanded model matrices are not full rank, but a coefficient
+vector $\beta_i$ can still be found due to the zero-centered prior on
+non-intercept coefficients. The prior variance for the log2 fold
+changes is calculated by first generating maximum likelihood estimates
+for a standard model matrix. The prior variance for each level of a
+factor is then set as the average of the mean squared maximum
+likelihood estimates for each level and every possible contrast, such
+that that this prior value will be reference-level-independent. The
+\Robject{contrast} argument of the \Rfunction{results} function is
+used in order to generate comparisons of interest.
+
+%--------------------------------------------------
+\subsection{Independent filtering and multiple testing} \label{sec:indepfilt}
+\subsubsection{Filtering criteria} \label{sec:filtbycount}
+%--------------------------------------------------
+
+The goal of independent filtering is to filter out those tests from the procedure
+that have no, or little chance of showing significant evidence, without even
+looking at their test statistic. Typically, this results in increased detection
+power at the same experiment-wide type I error. Here, we measure experiment-wide
+type I error in terms of the false discovery rate.
+
+A good choice for a filtering criterion is one that
+\begin{enumerate}
+ \item\label{it:indp} is statistically independent from the test statistic under the null hypothesis,
+ \item\label{it:corr} is correlated with the test statistic under the alternative, and
+ \item\label{it:joint} does not notably change the dependence structure --if there is any--
+ between the tests that pass the filter, compared to the dependence structure between the tests before filtering.
+\end{enumerate}
+
+The benefit from filtering relies on property \ref{it:corr}, and we will explore
+it further in Section~\ref{sec:whyitworks}. Its statistical validity relies on
+property \ref{it:indp} -- which is simple to formally prove for many combinations
+of filter criteria with test statistics-- and \ref{it:joint}, which is less
+easy to theoretically imply from first principles, but rarely a problem in practice.
+We refer to \cite{Bourgon:2010:PNAS} for further discussion of this topic.
+
+A simple filtering criterion readily available in the results object is the
+mean of normalized counts irrespective of biological condition (Figure \ref{figure/indFilt-1}),
+and so this is the criterion which is used automatically by the
+\Rfunction{results} function to perform independent filtering.
+Genes with very low counts are not likely to
+see significant differences typically due to high
+dispersion. For example, we can plot the $-\log_{10}$ $p$ values from all genes
+over the normalized mean counts.
+
+<<indFilt>>=
+plot(res$baseMean+1, -log10(res$pvalue),
+ log="x", xlab="mean of normalized counts",
+ ylab=expression(-log[10](pvalue)),
+ ylim=c(0,30),
+ cex=.4, col=rgb(0,0,0,.3))
+@
+
+\incfig{figure/indFilt-1}{.5\textwidth}{Mean counts as a filter statistic.}{
+ The mean of normalized counts provides an independent statistic for
+ filtering the tests. It is independent because the information about the
+ variables in the design formula is not used. By filtering out genes which fall
+ on the left side of the plot, the majority of the low $p$ values are kept.
+}
+
+%--------------------------------------------------
+\subsubsection{Why does it work?}\label{sec:whyitworks}
+%--------------------------------------------------
+
+Consider the $p$ value histogram in Figure \ref{figure/fighistindepfilt-1}.
+It shows how the filtering ameliorates the multiple testing problem
+-- and thus the severity of a multiple testing adjustment -- by
+removing a background set of hypotheses whose $p$ values are distributed
+more or less uniformly in $[0,1]$.
+
+<<histindepfilt, dev="pdf", fig.width=7, fig.height=5>>=
+use <- res$baseMean > metadata(res)$filterThreshold
+h1 <- hist(res$pvalue[!use], breaks=0:50/50, plot=FALSE)
+h2 <- hist(res$pvalue[use], breaks=0:50/50, plot=FALSE)
+colori <- c(`do not pass`="khaki", `pass`="powderblue")
+@
+
+<<fighistindepfilt>>=
+barplot(height = rbind(h1$counts, h2$counts), beside = FALSE,
+ col = colori, space = 0, main = "", ylab="frequency")
+text(x = c(0, length(h1$counts)), y = 0, label = paste(c(0,1)),
+ adj = c(0.5,1.7), xpd=NA)
+legend("topright", fill=rev(colori), legend=rev(names(colori)))
+@
+
+\incfig{figure/fighistindepfilt-1}{.5\textwidth}{Histogram of p values for all tests.}{
+ The area shaded in blue indicates the subset of those that pass the filtering,
+ the area in khaki those that do not pass.
+}
+
+\section{Frequently asked questions} \label{sec:faq}
+
+\subsection{How can I get support for DESeq2?}
+
+We welcome questions about our software, and want to
+ensure that we eliminate issues if and when they appear. We have a few
+requests to optimize the process:
+
+\begin{itemize}
+\item all questions should take place on the Bioconductor support
+ site: \url{https://support.bioconductor.org}, which serves as a
+ repository of questions and answers. This helps to save the
+ developers' time in responding to similar questions. Make sure to
+ tag your post with ``deseq2''. It is often very helpful in addition
+ to describe the aim of your experiment.
+\item before posting, first search the Bioconductor support site
+ mentioned above for past threads which might have answered your
+ question.
+\item if you have a question about the behavior of a function, read
+ the sections of the manual page for this function by typing a
+ question mark and the function name, e.g. \Robject{?results}. We
+ spend a lot of time documenting individual functions and the exact
+ steps that the software is performing.
+\item include all of your R code, especially the creation of the
+ \Rclass{DESeqDataSet} and the design formula. Include complete
+ warning or error messages, and conclude your message with the full
+ output of \Robject{sessionInfo()}.
+\item if possible, include the output of
+ \Robject{as.data.frame(colData(dds))}, so that we can have a sense
+ of the experimental setup. If this contains confidential
+ information, you can replace the levels of those factors using
+ \Rfunction{levels()}.
+\end{itemize}
+
+\subsection{Why are some $p$ values set to \texttt{NA}?}
+
+See the details in Section~\ref{sec:moreInfo}.
+
+\subsection{How can I get unfiltered DESeq results?}
+
+Users can obtain unfiltered GLM results, i.e. without outlier removal
+or independent filtering with the following call:
+
+<<vanillaDESeq, eval=FALSE>>=
+dds <- DESeq(dds, minReplicatesForReplace=Inf)
+res <- results(dds, cooksCutoff=FALSE, independentFiltering=FALSE)
+@
+
+In this case, the only $p$ values set to \Robject{NA} are those from
+genes with all counts equal to zero.
+
+\subsection{How do I use the variance stabilized or rlog
+ transformed data for differential testing?}
+
+ The variance stabilizing and rlog transformations are provided for
+ applications other than differential testing, for example clustering
+ of samples or other machine learning applications. For differential
+ testing we recommend the \Rfunction{DESeq} function applied to raw
+ counts as outlined in Section~\ref{sec:de}.
+
+\subsection{Can I use DESeq2 to analyze paired samples?}
+
+Yes, you should use a multi-factor design which includes the sample
+information as a term in the design formula. This will account for
+differences between the samples while estimating the effect due to
+the condition. The condition of interest should go at the end of the
+design formula. See Section~\ref{sec:multifactor}.
+
+\subsection{Can I run DESeq2 to contrast the levels of 100 groups?}
+
+\deseqtwo{} will work with any kind of design specified using the R
+formula. We enourage users to consider exploratory data analysis such
+as principal components analysis as described in Section~\ref{sec:pca},
+rather than performing statistical testing of all combinations of
+dozens of groups.
+
+As a speed concern with fitting very large models,
+note that each additional level of a factor in the
+design formula adds another parameter to the GLM which is fit by
+\deseqtwo. Users might consider first removing genes with very few
+reads, e.g.\ genes with row sum of 1, as this will speed up the
+fitting procedure.
+
+\subsection{Can I use DESeq2 to analyze a dataset without replicates?}
+
+If a \Rclass{DESeqDataSet} is provided with an experimental design without replicates,
+a message is printed, that the samples are treated as replicates
+for estimation of dispersion. More details can be found in the
+manual page for \Rfunction{?DESeq}.
+
+\subsection{How can I include a continuous covariate in the design formula?}
+
+Continuous covariates can be included in the design formula in the
+same manner as factorial covariates. Continuous covariates might make
+sense in certain experiments, where a constant fold change might be
+expected for each unit of the covariate. However, in many cases, more
+meaningful results can be obtained by cutting continuous covariates
+into a factor defined over a small number of bins (e.g. 3-5). In this
+way, the average effect of each group is controlled for, regardless of
+the trend over the continuous covariates. In R, \Rclass{numeric}
+vectors can be converted into \Rclass{factors} using the function
+\Rfunction{cut}.
+
+\subsection{What are the exact steps performed by \Rfunction{DESeq()}?}
+
+See the manual page for \Rfunction{DESeq}, which links to the
+subfunctions which are called in order, where complete details are listed.
+
+\subsection{Is there an official Galaxy tool for DESeq2?}
+
+Yes. The repository for the \deseqtwo{} tool is
+\url{https://github.com/galaxyproject/tools-iuc/tree/master/tools/deseq2}
+and a link to its location in the Tool Shed is
+\url{https://toolshed.g2.bx.psu.edu/view/iuc/deseq2/d983d19fbbab}.
+
+\section{Acknowledgments}
+
+We have benefited in the development of \deseqtwo{} from the help and
+feedback of many individuals, including but not limited to:
+The Bionconductor Core Team,
+Alejandro Reyes, Andrzej Ole\'s, Aleksandra Pekowska, Felix Klein,
+Vince Carey,
+Devon Ryan,
+Steve Lianoglou, Jessica Larson, Christina Chaivorapol, Pan Du, Richard Bourgon,
+Willem Talloen,
+Elin Videvall, Hanneke van Deutekom,
+Todd Burwell,
+Jesse Rowley,
+Igor Dolgalev,
+Stephen Turner,
+Ryan C Thompson,
+Tyr Wiesner-Hanks,
+Konrad Rudolph,
+David Robinson,
+Mingxiang Teng,
+Mathias Lesche,
+Sonali Arora,
+Jordan Ramilowski,
+Ian Dworkin,
+Bj\"orn Gr\"uning,
+Ryan McMinds.
+\section{Session Info}
+
+<<sessInfo, results="asis", echo=FALSE>>=
+toLatex(sessionInfo())
+@
+
+<<resetOptions, results="hide", echo=FALSE>>=
+options(prompt="> ", continue="+ ")
+@
+
+\bibliography{library}
+
+\end{document}
diff --git a/vignettes/library.bib b/vignettes/library.bib
new file mode 100644
index 0000000..5b9bea0
--- /dev/null
+++ b/vignettes/library.bib
@@ -0,0 +1,243 @@
+ at article{Love2014,
+ url = {http://dx.doi.org/10.1186/s13059-014-0550-8},
+ author = {Love, Michael I. and Huber, Wolfgang and Anders, Simon},
+ title = {{Moderated estimation of fold change and dispersion
+ for RNA-seq data with DESeq2}},
+ journal = {Genome Biology},
+ year = 2014,
+ Volume = 15,
+ Issue = 12,
+ Pages = 550,
+}
+
+ at article{Anders:2010:GB,
+ url = {http://genomebiology.com/2010/11/10/R106},
+ author = {Anders, Simon and Huber, Wolfgang},
+ Title = {Differential expression analysis for sequence
+ count data},
+ Journal = {Genome Biology},
+ Year = 2010,
+ Volume = 11,
+ Pages = {R106},
+}
+
+ at article{Anders:2014:htseq,
+ url = {http://dx.doi.org/10.1093/bioinformatics/btu638},
+ author = {Anders, Simon and Pyl, Paul Theodor and Huber, Wolfgang},
+ title = {{HTSeq -- A Python framework to work with high-throughput sequencing data}},
+ journal = {Bioinformatics},
+ year = 2014,
+}
+
+ at article{BH:1995,
+ author = {Benjamini, Yoav and Hochberg, Yosef},
+ title = {Controlling the false discovery rate: a practical
+ and powerful approach to multiple testing},
+ journal = "Journal of the Royal Statistical Society B",
+ year = 1995,
+ volume = 57,
+ pages = "289--300"
+}
+
+ at article{Bourgon:2010:PNAS,
+ ISI = {ISI:000278054700015},
+ URL = {http://www.pnas.org/content/107/21/9546.long},
+ PDF = {PNAS-2010-Bourgon-9546-51.pdf},
+ author = {Bourgon, Richard and Gentleman, Robert and Huber, Wolfgang},
+ Title = {Independent filtering increases detection power for
+ high-throughput experiments},
+ journal = {PNAS},
+ Year = 2010,
+ volume = 107,
+ number = 21,
+ pages = {9546--9551},
+}
+
+ at article{Brooks2010,
+ author = {Brooks, A. N. and Yang, L. and Duff, M. O. and
+ Hansen, K. D. and Park, J. W. and Dudoit, S. and
+ Brenner, S. E. and Graveley, B. R.},
+ doi = {10.1101/gr.108662.110},
+ issn = {1088-9051},
+ journal = {Genome Research},
+ pages = {193--202},
+ title = {{Conservation of an RNA regulatory map between
+ Drosophila and mammals}},
+ url =
+ {http://genome.cshlp.org/cgi/doi/10.1101/gr.108662.110},
+ year = 2011
+}
+
+ at article{Tibshirani1988,
+ author = {Tibshirani, Robert},
+ title = {Estimating transformations for regression via
+ additivity and variance stabilization},
+ journal = {Journal of the American Statistical Association},
+ year = 1988,
+ volume = 83,
+ pages = {394--405}
+}
+
+ at misc{htseq,
+ author = {Anders, Simon},
+ title = {{HTSeq: Analysing high-throughput sequencing data
+ with Python}},
+ year = 2011,
+ howpublished = {\url{http://www-huber.embl.de/users/anders/HTSeq/}}
+}
+
+ at article{sagmb2003,
+ title = {Parameter estimation for the calibration and
+ variance stabilization of microarray data},
+ author = {Huber, Wolfgang and von Heydebreck, Anja and
+ {S\"ultmann}, Holger and Poustka, Annemarie and Vingron, Martin},
+ journal = {Statistical Applications in Genetics and Molecular
+ Biology},
+ year = 2003,
+ volume = 2,
+ number = 1,
+ pages = {Article 3}
+}
+
+ at misc{summarizeOverlaps,
+ author = {Valerie Obenchain},
+ title = {Counting with \texttt{summarizeOverlaps}},
+ year = 2011,
+ howpublished = {Vignette, distributed as part of the Bioconductor
+ package \emph{GenomicAlignments}, as file
+ \emph{summarizeOverlaps.pdf}}
+}
+
+ at article{Anders:2012:GR,
+ author = {Anders, Simon and Reyes, Alejandro and Huber, Wolfgang},
+ title = {Detecting differential usage of exons from {RNA-seq} data },
+ year = {2012},
+ journal = {Genome Research},
+ doi = {10.1101/gr.133744.111},
+}
+
+ at article{CR,
+author = {Cox, D. R. and Reid, N.},
+journal = {Journal of the Royal Statistical Society, Series B},
+keywords = {CML,Cox-Reid,ML,dispersion},
+mendeley-tags = {CML,Cox-Reid,ML,dispersion},
+number = {1},
+pages = {1--39},
+title = {{Parameter orthogonality and approximate conditional inference}},
+url = {http://www.jstor.org/stable/2345476},
+volume = {49},
+year = {1987}
+}
+
+ at article{edgeR_GLM,
+author = {McCarthy, Davis J and Chen, Yunshun and Smyth, Gordon K},
+doi = {10.1093/nar/gks042},
+issn = {1362-4962},
+journal = {Nucleic Acids Research},
+keywords = {edgeR},
+mendeley-tags = {edgeR},
+month = jan,
+pmid = {22287627},
+title = {{Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation}},
+url = {http://www.ncbi.nlm.nih.gov/pubmed/22287627},
+year = {2012},
+volume={40},
+pages={4288-4297}
+}
+
+ at article{SchwederSpjotvoll1982,
+author={Schweder, T. and Spj\/{o}tvoll, E.},
+title={Plots of {P-values} to evaluate many tests simultaneously},
+journal={Biometrika},
+year={1982},
+volume=69,
+pages={493-502},
+doi={10.1093/biomet/69.3.493}
+}
+
+ at article{Wu2012New,
+ author = {Wu, Hao and Wang, Chi and Wu, Zhijin},
+ day = {22},
+ doi = {10.1093/biostatistics/kxs033},
+ issn = {1468-4357},
+ journal = {Biostatistics},
+ month = sep,
+ pmid = {23001152},
+ posted-at = {2013-02-26 17:09:19},
+ priority = {2},
+ publisher = {Oxford University Press},
+ title = {{A new shrinkage estimator for dispersion improves differential expression detection in RNA-seq data}},
+ url = {http://dx.doi.org/10.1093/biostatistics/kxs033},
+ year = {2012}
+}
+
+ at article{Cook1977Detection,
+ author = {R. Dennis Cook},
+ journal = {Technometrics},
+ month = feb,
+ year = {1977},
+ title = {{Detection of Influential Observation in Linear Regression}}
+}
+
+ at article{Bickel2010Subsampling,
+ author = {Bickel, Peter J. and Boley, Nathan and Brown, James B. and Huang, Haiyan and Zhang, Nancy R.},
+ day = {5},
+ doi = {10.1214/10-aoas363},
+ eprint = {1101.0947},
+ issn = {1932-6157},
+ journal = {The Annals of Applied Statistics},
+ month = dec,
+ number = {4},
+ pages = {1660--1697},
+ title = {{Subsampling methods for genomic inference}},
+ url = {http://dx.doi.org/10.1214/10-aoas363},
+ volume = {4},
+ year = {2010}
+}
+
+ at article{Li2009SAMtools,
+author = {Li, Heng and Handsaker, Bob and Wysoker, Alec and Fennell, Tim and Ruan, Jue and Homer, Nils and Marth, Gabor and Abecasis, Goncalo and Durbin, Richard and 1000 Genome Project Data Processing Subgroup},
+title = {{The Sequence Alignment/Map format and SAMtools}},
+volume = {25},
+number = {16},
+pages = {2078-2079},
+year = {2009},
+doi = {10.1093/bioinformatics/btp352},
+URL = {http://bioinformatics.oxfordjournals.org/content/25/16/2078.abstract},
+eprint = {http://bioinformatics.oxfordjournals.org/content/25/16/2078.full.pdf+html},
+journal = {Bioinformatics}
+}
+
+ at article{Kim2013TopHat2,
+ author = {Kim, Daehwan and Pertea, Geo and Trapnell, Cole and Pimentel, Harold and Kelley, Ryan and Salzberg, Steven},
+ doi = {10.1186/gb-2013-14-4-r36},
+ issn = {1465-6906},
+ journal = {Genome Biology},
+ number = {4},
+ pages = {R36+},
+ pmid = {23618408},
+ title = {{TopHat2: accurate alignment of transcriptomes in the presence of insertions, deletions and gene fusions}},
+ url = {http://dx.doi.org/10.1186/gb-2013-14-4-r36},
+ volume = {14},
+ year = {2013}
+}
+
+
+ at Article{Delhomme2012easy,
+ Author={Delhomme, N. and Padioleau, I. and Furlong, E. E. and Steinmetz, L. M.},
+ Title={{easyRNASeq: a Bioconductor package for processing RNA-Seq data}},
+ Journal={Bioinformatics},
+ Year={2012},
+ Volume={28},
+ Number={19},
+ Pages={2532--2533},
+ Month={Oct}
+}
+
+ at Article{Liao2013feature,
+ Author={Liao, Y. and Smyth, G. K. and Shi, W.},
+ Title={{featureCounts: an efficient general purpose program for assigning sequence reads to genomic features}},
+ Journal={Bioinformatics},
+ Year={2013},
+ Month={Nov}
+}
diff --git a/vignettes/vst.nb b/vignettes/vst.nb
new file mode 100644
index 0000000..3f0b191
--- /dev/null
+++ b/vignettes/vst.nb
@@ -0,0 +1,1000 @@
+(* Content-type: application/mathematica *)
+
+(*** Wolfram Notebook File ***)
+(* http://www.wolfram.com/nb *)
+
+(* CreatedBy='Mathematica 7.0' *)
+
+(*CacheID: 234*)
+(* Internal cache information:
+NotebookFileLineBreakTest
+NotebookFileLineBreakTest
+NotebookDataPosition[ 145, 7]
+NotebookDataLength[ 35124, 991]
+NotebookOptionsPosition[ 32281, 895]
+NotebookOutlinePosition[ 32848, 915]
+CellTagsIndexPosition[ 32805, 912]
+WindowFrame->Normal*)
+
+(* Beginning of Notebook Content *)
+Notebook[{
+
+Cell[CellGroupData[{
+Cell["Variance-stabilizing transformation for DESeq", "Subtitle",
+ CellChangeTimes->{{3.540622683759346*^9, 3.5406226961574497`*^9}, {
+ 3.540815669170343*^9, 3.540815673334532*^9}}],
+
+Cell[BoxData[
+ StyleBox[
+ RowBox[{
+ RowBox[{"For", " ", "parametrized", " ", "dispersion", " ", "fit"}],
+ "\[IndentingNewLine]"}], "Subsubtitle"]], "Input",
+ CellChangeTimes->{{3.540815676143361*^9, 3.5408157093482103`*^9}}],
+
+Cell[TextData[{
+ "This file describes the variance stabilizing transformation (VST) used by \
+DESeq when parametric dispersion estimation is used.\nThis is a ",
+ StyleBox["Mathematica",
+ FontSlant->"Italic"],
+ " notebook. The file ",
+ StyleBox["vst.pdf",
+ FontSlant->"Italic"],
+ " is produced from ",
+ StyleBox["vst.nb",
+ FontSlant->"Italic"],
+ "."
+}], "Text",
+ CellChangeTimes->{{3.5407069553696613`*^9, 3.540707011225795*^9}}],
+
+Cell[BoxData[""], "Input",
+ CellChangeTimes->{{3.540706950820628*^9, 3.540706952072029*^9}}],
+
+Cell[TextData[{
+ "When using ",
+ StyleBox["estimateDispersions",
+ FontSlant->"Italic"],
+ " with ",
+ StyleBox["fitType=\"parametric\"",
+ FontSlant->"Italic"],
+ ", we parametrize the relation between mean \[Mu] and dispersion \[Alpha] \
+with two constants ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "0"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " and ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "1"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ "as follows:"
+}], "Text",
+ CellChangeTimes->{{3.540622754917987*^9, 3.5406228441955957`*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"\[Alpha]", " ", "=", " ",
+ RowBox[{
+ SubscriptBox["a", "0"], "+",
+ RowBox[{
+ SubscriptBox["a", "1"], "/", "\[Mu]"}]}]}]], "Input",
+ CellChangeTimes->{{3.540622709621419*^9, 3.540622751006365*^9}, {
+ 3.5406228468149643`*^9, 3.540622847455463*^9}, {3.540622881311955*^9,
+ 3.540622881653171*^9}}],
+
+Cell[BoxData[
+ RowBox[{
+ SubscriptBox["a", "0"], "+",
+ FractionBox[
+ SubscriptBox["a", "1"], "\[Mu]"]}]], "Output",
+ CellChangeTimes->{3.5406228483207407`*^9, 3.540622882333549*^9,
+ 3.5406235190432873`*^9, 3.54070632548785*^9}]
+}, Open ]],
+
+Cell[TextData[{
+ "In the package, ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "0"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " is called the ",
+ StyleBox["asymptotic dispersion",
+ FontSlant->"Italic"],
+ " and ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "1"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " the ",
+ StyleBox["extra-Poisson factor",
+ FontSlant->"Italic"],
+ "."
+}], "Text",
+ CellChangeTimes->{{3.540625116841147*^9, 3.54062515229095*^9}}],
+
+Cell["The variance is hence", "Text",
+ CellChangeTimes->{{3.5406228589902277`*^9, 3.540622862149235*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"v", " ", "=", " ",
+ RowBox[{
+ RowBox[{"\[Mu]", " ", "+", " ",
+ RowBox[{"\[Alpha]", " ",
+ SuperscriptBox["\[Mu]", "2"]}]}], "//", "Expand"}]}]], "Input",
+ CellChangeTimes->{{3.540622864971992*^9, 3.540622905693181*^9}}],
+
+Cell[BoxData[
+ RowBox[{"\[Mu]", "+",
+ RowBox[{
+ SuperscriptBox["\[Mu]", "2"], " ",
+ SubscriptBox["a", "0"]}], "+",
+ RowBox[{"\[Mu]", " ",
+ SubscriptBox["a", "1"]}]}]], "Output",
+ CellChangeTimes->{{3.5406228908884497`*^9, 3.540622906087739*^9},
+ 3.540623520780364*^9, 3.540706328495348*^9}]
+}, Open ]],
+
+Cell[TextData[{
+ "A variance stabilizing transformation (VST) is a transformation ",
+ StyleBox["u",
+ FontSlant->"Italic"],
+ ", such that, if ",
+ StyleBox["X", "InlineFormula",
+ FontSlant->"Italic"],
+ " is a random variable with variance-mean relation ",
+ StyleBox["v",
+ FontSlant->"Italic"],
+ ", i.e.,",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{
+ RowBox[{"Var", "(", "X", ")"}], "=",
+ RowBox[{"v", "(",
+ RowBox[{
+ StyleBox["E",
+ FontSlant->"Plain"], "(", "X", ")"}], ")"}]}], TraditionalForm]]],
+ ", then ",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{"u", "(", "X", ")"}], TraditionalForm]]],
+ " has stabilized variance, i.e., is homoskedastic.\[LineSeparator]\nA VST ",
+ StyleBox["u",
+ FontSlant->"Italic"],
+ " can be derived from a variance-mean relation ",
+ StyleBox["v",
+ FontSlant->"Italic"],
+ " by ",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{
+ RowBox[{"u", "(", "x", ")"}], " ", "=",
+ RowBox[{
+ SuperscriptBox["\[Integral]", "x"],
+ FractionBox["d\[Mu]",
+ SqrtBox[
+ RowBox[{"v", "(", "\[Mu]", ")"}]]]}]}], TraditionalForm]]],
+ ". \nHence, we can get a general VST with"
+}], "Text",
+ CellChangeTimes->{{3.5406229237822933`*^9, 3.540622976488544*^9}, {
+ 3.5406230186338882`*^9, 3.5406234172645473`*^9}, 3.540623709187056*^9}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{
+ SubscriptBox["u", "0"], "=",
+ RowBox[{"Integrate", "[", " ",
+ RowBox[{
+ FractionBox["1",
+ SqrtBox["v"]], ",",
+ RowBox[{"{",
+ RowBox[{"\[Mu]", ",", "0", ",", "x"}], "}"}], ",", " ",
+ RowBox[{"Assumptions", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]}]], "Input",
+ CellChangeTimes->{{3.540623530465404*^9, 3.5406235592399807`*^9}, {
+ 3.540623599688093*^9, 3.5406236174438133`*^9}, {3.54062365174788*^9,
+ 3.5406236985888433`*^9}, {3.5406237316160307`*^9, 3.540623763300437*^9}, {
+ 3.5406239927503653`*^9, 3.5406240020590677`*^9}}],
+
+Cell[BoxData[
+ FractionBox[
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"1", "+",
+ RowBox[{"2", " ", "x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"], "+",
+ RowBox[{"2", " ",
+ SqrtBox[
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"], " ",
+ RowBox[{"(",
+ RowBox[{"1", "+",
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"]}], ")"}]}]]}]}],
+ RowBox[{"1", "+",
+ SubscriptBox["a", "1"]}]], "]"}],
+ SqrtBox[
+ SubscriptBox["a", "0"]]]], "Output",
+ CellChangeTimes->{3.5406237656511507`*^9, 3.5406240086931467`*^9,
+ 3.540706337835845*^9}]
+}, Open ]],
+
+Cell[TextData[{
+ "If ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["u", "0"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " is a VST, then so is ",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{
+ RowBox[{"u", "(", "x", ")"}], "=",
+ RowBox[{
+ RowBox[{"\[Eta]", " ",
+ RowBox[{
+ SubscriptBox["u", "0"], "(", "x", ")"}]}], "+", "\[Xi]"}]}],
+ TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ ". Hence, this here is a VST, too:"
+}], "Text",
+ CellChangeTimes->{{3.54062372243547*^9, 3.540623757039871*^9}, {
+ 3.54062379375005*^9, 3.540623799888122*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"u", " ", "=", " ",
+ RowBox[{
+ RowBox[{"\[Eta]", " ",
+ SubscriptBox["u", "0"]}], " ", "+", " ", "\[Xi]"}]}]], "Input",
+ CellChangeTimes->{{3.540623420986374*^9, 3.540623478619273*^9}, {
+ 3.540623773769244*^9, 3.540623774356125*^9}}],
+
+Cell[BoxData[
+ RowBox[{"\[Xi]", "+",
+ FractionBox[
+ RowBox[{"\[Eta]", " ",
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"1", "+",
+ RowBox[{"2", " ", "x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"], "+",
+ RowBox[{"2", " ",
+ SqrtBox[
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"], " ",
+ RowBox[{"(",
+ RowBox[{"1", "+",
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"]}], ")"}]}]]}]}],
+ RowBox[{"1", "+",
+ SubscriptBox["a", "1"]}]], "]"}]}],
+ SqrtBox[
+ SubscriptBox["a", "0"]]]}]], "Output",
+ CellChangeTimes->{3.540623775240573*^9, 3.5406240154345617`*^9,
+ 3.540706341376553*^9}]
+}, Open ]],
+
+Cell[TextData[{
+ "We will now choose the parameters \[Eta] and \[Xi] such that our VST \
+behaves like ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["log", "2"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " for large values. Let us first look at the asymptotic ratio of the two \
+transformations:"
+}], "Text",
+ CellChangeTimes->{{3.5406237859608927`*^9, 3.540623835015697*^9}, {
+ 3.540623912031002*^9, 3.5406239291035957`*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Limit", "[",
+ RowBox[{
+ RowBox[{"u", "/",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}]}], ",",
+ RowBox[{"x", "\[Rule]", "\[Infinity]"}], ",",
+ RowBox[{"Assumptions", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.540623840409006*^9, 3.540623897293412*^9}}],
+
+Cell[BoxData[
+ FractionBox[
+ RowBox[{"\[Eta]", " ",
+ RowBox[{"Log", "[", "2", "]"}]}],
+ SqrtBox[
+ SubscriptBox["a", "0"]]]], "Output",
+ CellChangeTimes->{
+ 3.5406238532935*^9, {3.540623884009026*^9, 3.540623898620083*^9},
+ 3.540623932367114*^9, 3.540624018553113*^9, 3.540706350438925*^9}]
+}, Open ]],
+
+Cell["\<\
+Hence, if we set \[Eta] as follows, both tranformations have asymptotically \
+the ratio 1.\
+\>", "Text",
+ CellChangeTimes->{{3.540623941645524*^9, 3.540623964772687*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"\[Eta]", "=",
+ FractionBox[
+ SqrtBox[
+ SubscriptBox["a", "0"]],
+ RowBox[{"Log", "[", "2", "]"}]]}]], "Input",
+ CellChangeTimes->{{3.5406239683083763`*^9, 3.540623985663389*^9}}],
+
+Cell[BoxData[
+ FractionBox[
+ SqrtBox[
+ SubscriptBox["a", "0"]],
+ RowBox[{"Log", "[", "2", "]"}]]], "Output",
+ CellChangeTimes->{3.54062402054701*^9, 3.5407063538642073`*^9}]
+}, Open ]],
+
+Cell["We also want the difference to vanish for large values:", "Text",
+ CellChangeTimes->{{3.5406240570203876`*^9, 3.540624066501199*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Limit", "[",
+ RowBox[{
+ RowBox[{"u", "-",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}]}], ",",
+ RowBox[{"x", "\[Rule]", "\[Infinity]"}], ",",
+ RowBox[{"Assumptions", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.540624078076254*^9, 3.5406240782935953`*^9}}],
+
+Cell[BoxData[
+ RowBox[{"\[Xi]", "+",
+ FractionBox[
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"4", " ",
+ SubscriptBox["a", "0"]}],
+ RowBox[{"1", "+",
+ SubscriptBox["a", "1"]}]], "]"}],
+ RowBox[{"Log", "[", "2", "]"}]]}]], "Output",
+ CellChangeTimes->{3.540624079366681*^9, 3.5407063578189287`*^9}]
+}, Open ]],
+
+Cell["So, we set", "Text",
+ CellChangeTimes->{{3.540624088556891*^9, 3.540624089891953*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"\[Xi]", "=",
+ RowBox[{"-",
+ FractionBox[
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"4", " ",
+ SubscriptBox["a", "0"]}],
+ RowBox[{"1", "+",
+ SubscriptBox["a", "1"]}]], "]"}],
+ RowBox[{"Log", "[", "2", "]"}]]}]}]], "Input",
+ CellChangeTimes->{{3.540624101066662*^9, 3.54062410215302*^9}}],
+
+Cell[BoxData[
+ RowBox[{"-",
+ FractionBox[
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"4", " ",
+ SubscriptBox["a", "0"]}],
+ RowBox[{"1", "+",
+ SubscriptBox["a", "1"]}]], "]"}],
+ RowBox[{"Log", "[", "2", "]"}]]}]], "Output",
+ CellChangeTimes->{3.5406241034473743`*^9, 3.5407063616117477`*^9}]
+}, Open ]],
+
+Cell["Check that both limits are now correct:", "Text",
+ CellChangeTimes->{{3.540624108213401*^9, 3.5406241294046183`*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Limit", "[",
+ RowBox[{
+ RowBox[{"u", "/",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}]}], ",",
+ RowBox[{"x", "\[Rule]", "\[Infinity]"}], ",",
+ RowBox[{"Assumptions", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]], "Input"],
+
+Cell[BoxData["1"], "Output",
+ CellChangeTimes->{3.540624144767686*^9, 3.540706364776153*^9}]
+}, Open ]],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Limit", "[",
+ RowBox[{
+ RowBox[{"u", "-",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}]}], ",",
+ RowBox[{"x", "\[Rule]", "\[Infinity]"}], ",",
+ RowBox[{"Assumptions", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.5406241492285852`*^9, 3.540624149396823*^9}}],
+
+Cell[BoxData["0"], "Output",
+ CellChangeTimes->{3.5406241503157988`*^9, 3.5407063658855057`*^9}]
+}, Open ]],
+
+Cell["Hence, we arrive at this VST:", "Text",
+ CellChangeTimes->{{3.540624156886202*^9, 3.5406241624452667`*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"FullSimplify", "[",
+ RowBox[{"u", ",",
+ RowBox[{"Assumptions", "->",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.54062416605935*^9, 3.540624190033182*^9}, {
+ 3.54062534911759*^9, 3.5406253565459948`*^9}}],
+
+Cell[BoxData[
+ FractionBox[
+ RowBox[{"Log", "[",
+ FractionBox[
+ RowBox[{"1", "+",
+ RowBox[{"2", " ", "x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"], "+",
+ RowBox[{"2", " ",
+ SqrtBox[
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"], " ",
+ RowBox[{"(",
+ RowBox[{"1", "+",
+ RowBox[{"x", " ",
+ SubscriptBox["a", "0"]}], "+",
+ SubscriptBox["a", "1"]}], ")"}]}]]}]}],
+ RowBox[{"4", " ",
+ SubscriptBox["a", "0"]}]], "]"}],
+ RowBox[{"Log", "[", "2", "]"}]]], "Output",
+ CellChangeTimes->{{3.5406241686802197`*^9, 3.54062419149958*^9},
+ 3.54062535102468*^9, 3.540706368929482*^9}]
+}, Open ]],
+
+Cell[TextData[{
+ "This VST (red) now behaves asymptotically as ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["log", "2"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " (blue), shown here for typical values for ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "0"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " and ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["a", "1"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ "."
+}], "Text",
+ CellChangeTimes->{{3.540624324957206*^9, 3.5406243429895267`*^9}, {
+ 3.540624623453052*^9, 3.5406246604775143`*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Plot", "[", " ",
+ RowBox[{
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{"u", "/.",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], "\[Rule]", ".01"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], "->", "3"}]}], "}"}]}], ",",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}]}], "}"}], ",",
+ RowBox[{"{",
+ RowBox[{"x", ",", "0", ",", "10000"}], "}"}], ",",
+ RowBox[{"PlotStyle", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{"Red", ",", "Blue"}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.540624219476747*^9, 3.540624313819049*^9}, {
+ 3.540624609588531*^9, 3.5406246195269203`*^9}}],
+
+Cell[BoxData[
+ GraphicsBox[{{}, {},
+ {RGBColor[1, 0, 0], LineBox[CompressedData["
+1:eJwVz3k4lAsbBnBRoUJIpTRmsc1LC4noq25ZsuV0hJxsZSvLZxtpbNlphsiS
+kC0ksrRIyhLjraSiTkKcLJ1TsqtUhK/OfH8813P9rvu5/3hozr6WboICAgIR
+/Pn/9r11aC7hmxFazIYc0z0omI6b/rSDY4xoQc1cCpeC5+I/M0hJU2gIPW2l
+llFw/ZKYjk2OGa7VJ/UQjyhwK1eLCq2wgNDuZImSJQp83GtF/nG3xOLsYaNO
+Z3kMEE3H1FSPQK2j+rf2EHmYzzysPD1zBKrbl3lpp8mDYL8+LMK2xsWLGrmJ
+zfIY4cxmbeXYYsAoe8llFRXWFovjQYf+gNrjTh53HRUPpYT2tkgeQ7yRfEE0
+hYqiy1LvLHPskKRhwplSp8KhSp3JrnBEePSM6bANFZ6jdfbv3J2hI5me4pnD
+v3/asGJluzPedjESbIuo6KtsriZUXfC71qSp2nUqjP3bBAJnXLCt6oXBuftU
+KC30lKxku0GqzzlAsZeKv1d/n1TlnEL1ztyzbHEanI7WzqTOnsKbidUiuTI0
+vC0K/DLn4IHwJRPXCjkaenRm50gNT2jm0LkpBA1PT34StH/rhZML1lohhjTc
+Jsc3Jm33xWfT7qPqbBq2S1zf/CXbF9ofH1MMztJgU6UpoSbohyKjLW3GsTR0
+zc9Kpnn74YL3zR6VCzR0pARscNTzR5rUY02zazTwmnzp38cDIHhr4wfzLhoi
+XV4wmFQWGMVOwzlvaNgnul3R3poFinuP5eAADQ1W08qtzSwopY9aGI3SUDvh
+vTU5IxDaalf2FyzRUC7ruVtpXxD2lVZdzGTQkXra1cImNRjDaxTCwrzoCMnM
+7RAkg/G8Ln9lkC8drnWvzW98DcazCrdODxYdWj8MzERsQxD4p5cdQunoD1M0
+rqeE4j/6j1DBpYMeO6JHqQzD6YebP8WV0XEn7dSukccRyJVm+N8YpiOvpvBO
+2nwEUkqLdcTe06HvOZktLxMJ50PeM+4f6VBLVJB9bhQJj5MsM/FpOn4+z9ig
+eD0SRIB239ZFOooPn17X6xeFV3njrHvrGJg8qiW+52c05MT0bLQMGdDsz8jI
+WB+DueaXB9cZMxBuP7tpelsMthwcNJsxZUD8xE3lK04x6LQeK849zMAOT0JP
+mBeDc58e6HbbMRAYRgnsionF2ogNv1r9Gfhf4cp+L9F4PHIcOlp7md8f77ma
+u46DPn2pvydGGSgzKoleuZ0DOe3hQ+4TDBwo9nfyM+Gg/sDFlMEpBoLs18ga
+nOVAhCFS8uQLA4OdekkTHzlYHikXErPEQFVNZYBuAxctuvpClyQUYB4evf/N
+iSRUOizNmmsqgLN2W5/0jRTkiwydz2QrQM3iqYvDZBrYokc85MYUsH/wTdke
+/Uw82R2Ur2mpiFdlux5Hc7NhEy7ZFV+pCAmlTbwT2blQex/N6pxTBHuqj2M2
+XgCD57InU/WU8KhmbZZ71BVYjIa6WUcqQTzZrvevFcXgZZmsl7qvhP+KZYTb
+VJRA8dyZRPEvSqC5X5DK0yyF1pzvWDxDGRMuIeJjg9cgMz/08Kq1Mr6dTQzy
+iCrHAUn1qw9ilGHFOt5RK1yBob/ONhtXKqN9DSNR+EYlNGLM9Ia6lZEeUa6t
+qFuNbON2VvWCMliXtpgZj9xA5kHl91lUFZi623/47dFNjOvn3V1uoILYqcTc
+E5xbiF+143WWiwpMDmoIf3e4DbqOwE2nWBXcP6/r4adQgyeMtp11V1TQ7myz
+bMXHGqw2D9vv2qQC11Vj5nL1d5DJTT5j0q+C8vyBFNmIWuSMLN4z+KqC4BUm
+8dlWd/FmqTHRR4KJsYW22zuV6uAidV2HyWRCaKCsp2asDhun+6OOg4nyVIHq
+u033EIerejxbJn5o1IcVxNxHV1J4YacPv++cEFVkWI9jwt+6OmKYcHV7pqOy
+sQHJ3FNp09lMcKz8x9LfNsDuWK/wryomdNYnm0ffagQpXzWnSDKR8XDNNRt2
+ExqkbOcdephIWVagbbjnAWL37rFsHGVCRrIs9K54Mxr3mcqoLDFhKCZdJ/a6
+GWMt77Z1ixEQ8Fl4NWvVgv46w6w4KoFqudMfpppasMde+p2XBoFbvMLZfnke
+/JWE4xsPEFh4kWAnyuXBrHXGQdiKQNZr+WZiigf10tyGly4E4gt5e/+waEUS
+8SR2PoBAfTdlfXtdK356bmqUjCGgv2zruOomEp75VgttqQTcz3vo/rOZxO35
+jYKiaQS4sqXcnC18v2csN+X7pbq8qiiNhFOw5Nwzvu2dJb1HlEkENpzMepFO
+IJD8NlW4i8S2r8Pt3RcJlMY9+CzzOwkTgcXpgWwC7ZKLeh2W/ByRepQcApN5
+2mmxViSITq9kR7417t7UmD1KorA+eMMQ3w9GilgvHUkMSyWNDF0m0Hsw4RvX
+m0RFj0vwcB7//y7S8IAPCT/v1gBqPgHKcYHMH74k+p9luh/n25UdrHWKReJe
+U8neYb4/lXmdMQwh4azrVz5UQEB6V1nbUiiJ3olLQfKFBLR47zfcCSdRvWbv
+Pie+w/oc7tGjSNR4CjUN8l3gliPSH03CJlkpkHKFQOvnHtvUWBKHpp8qOvL9
+IVy63DiehFb45z/z+BZZdfjHrwQSPlsvswf4/heHK5Fl
+ "]]},
+ {RGBColor[0, 0, 1], LineBox[CompressedData["
+1:eJwVz3k01QkfBnCULGPJSCGuu+Hen8qMsnSN8djaeCNJvMlOtsle1ixXVxfZ
+ciqlbC2WuERE2fqFo5i0EdPymimGMHGLqPTe+eN7nvP54znn+dK8Qx39JMTE
+xGJE92/2TTUnWO8LQKftG/czgRT8+cPCtB4/AF5XZ6jFxynwOHjrnzxhALbH
+FA+E5lLwsixqfvFwIBT4JenDFRQMbRcukgZBkHrYfzn2BQUPjnyQcHsZDP+j
+DhruW7Vwk5xSzdIPRbBUy8L7ES3oK1ZtnC8Mhc6Jd3NxM1pwrtmmuEkiDOrG
+7vAVo+LpZ6FSfkgYSmP4q/crUzGQE7HB3SIcXbEBSg+NqehqC6UvTEWAscel
++m48Fck+jxhsaiT69Xoyf+dS8auMvrbbgUho15CqDzKpuOM0q3uvIxJ1zUc0
+ky9Scet9yObsgijk//zc6mMLFZVqQSY6vx6Dz9SbsQNCKvKiffc658Wi3fjq
+DbP/0hB3tmhAgoyFb6KT61MPGnybn9kJPsYizLrM1t2PBqMla1tplzh8mnpW
+7hRGw2iC9q5WSjweSXr49p6kgZ42bkG5kYCY/2zJe1tLQ2N+gOF4TxJGaHsc
+ny/TcKmhpDH/cxJSZnclOH2nwSpoulBLJRlrjqgJ+lfRsSmTqda/Ixkq2YVp
+FXJ0rPQXbNCuSgb3o1B/LYWOcofodcNhKVgZowfVmdMxfdBIwXQlFdk3y7Or
+T9CxbbSgoGA9F1tPpm92S6Uj0U2oPruFC6mgQHVpHh0KXnW6pR5cHNfPkHc8
+TcdPQYSFVBcXqRN7Lwou0hGVQIl6yk3DHc+QVxea6fhWsmY0WIaHsceutcem
+6djB8PPspvGwInlW4+o/dGRfJccpHB5uBd+UG5yng1qVLHwcxEO49UruxiU6
+LBuW5Uz6eWgJvbbEl2SA1z1rvjonHQRHLfGBJgMKU0NXi9bxISHOyJKyY6Bi
+x5XUNfp83CcnXivaM2BZHu4RtpuPge9qkiqODBxzk1OzPsFHfD0xruLCwOvf
+LbLeT/BRNbRTMO/DQE3DjQjOnQw4OmZ1asYzYJeYav7CKwuqv/zg5XWdAf7a
+LSPKghzk18p1V31m4HbVRFRrbw6iXXrO/b3MwN/WpWu9/peDkmHlWuY3Bsp/
+kWUOS+fiWbRm3TlxJsTDEw8xObkoj47bHyjLRPuIz4P2olxcc0l1aNvIhEn1
+TxVCrzyoO9sOmJgxsWnvA5/D0/lgj9VHCeOZMH/9osLU6ixyi5TKVoRMPKkw
+7EnNKIQ99dShGFdtKOqod3kVFuFbNWElXqONmJkRvu1UMSRUHPbJrmiju2Ht
+ef+UUixq9CaFWOpAIfvQ8B+S5XDuH/v6NEkHv8kXJDpXX4HrwdKtzDYd0Pxz
+f7y07RqunH0zpzqvg/c+cQqTr68jJjhChquri08nMo8FplQiuL9fKtxFF06R
+ngO3pKrRNKd6dD9XF31yjEwpwQ2cmOee1hfo4kxSpbE2pxYCDQZn/LkuIs9p
+2u4aF2DaOTqk5psu9vi7vbPvrkO1kUN2J52FtJnMIi9+PTQ1WfN3rVjYvdNA
+auHwTVw51hoz6cdCy2lOYBizAf2U3U2RaSz0eTuLS040gNe4atyolAVf2Uk7
+jdZGzOnR/bd2sFB5+VWOWtItbNNbH0EdZSFWcjev0KkJrS4dn80WWJhc7r25
+VacZ8eQbzvBaNla9qhhqmGzGYNaX+kEWG5V5YrVNbbchyFvsXbBgY8mgNaGY
+24LO1afk613YmPROTymzaUXSb7PrHI6y4ev3cDtL9Q4Wn8i4rjvJBt8pfPLM
+yztIoxq8aCxkY/v6bLvU+rtIUpzyDRWwUXBf7rpzTBvcbCJH2SQbOeLFxjam
+7ZBbFdssPsSGilJFfJNCB15Jvq2ammTDRl65Wf5ZB2q2YWTNVzbEji4/ETp1
+wsPc/DFbkUCtRvS7mbZO7PuQoh5PI1DfVSIc1epCkvvgaj0DAsuP0g/JZHTB
+vtQy84UVgfPPtDqImS6MSx7+srSfAK+ky8x17z3cjlDKivIh0Pqcsr6v+R5M
+ZPjP/4okYCW+eUpPnYSMG0V1IpWA/+lAzl8bSby2HwljcwlkqF3LuKBJgsop
+JoNFHvxZS0+GRqLWxOHgB5HdvJVCxnVJ2LX5Gi+lEYgiP82UGJL4Omvzh0w6
+gWsn2+dU9pHQ997TopNJoE/pi8WAIwlD2fADASJPXzLOT3Mi4el0/32lyAZN
+dQbCgyTezH1cszmLQPt4WeSgOwljw4uLBqcJDO9M/5QRIuqr/HnPLEf0/1PS
+xvIoCVPPvRJJIlM8xc4uhZI4f3vRtFNk35hYo4BIEpVlkpctcwl8qAg+bhNH
+YnMPobkzj4CyYUXv13gSYxMXt5wS2ajr7YbGRBLZBo6cPpETRg7fpqeQ4Nnm
+wzafQLHfBenRVBJcTYpplsj35oZc8tJEe7WE+gMiv0tUrtzFI9G9/0cthTME
+pGUdlr6nk2C2Jkjbi/x/GXBYgQ==
+ "]]}},
+ AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948],
+ Axes->True,
+ AxesOrigin->{0, 8.},
+ PlotRange->{{0, 10000}, {7.603101236704731, 13.316142815535127`}},
+ PlotRangeClipping->True,
+ PlotRangePadding->{
+ Scaled[0.02],
+ Scaled[0.02]}]], "Output",
+ CellChangeTimes->{
+ 3.5406242472538157`*^9, {3.540624281049045*^9, 3.540624314895378*^9},
+ 3.5406246200625257`*^9, 3.540706377585573*^9}]
+}, Open ]],
+
+Cell["\<\
+For small values, however, the VST (red) compresses the dynamics much more \
+dramatically than the logarithm (blue) and the identity (green). This \
+reflects that the strong Poisson noise makes differences uninformative for \
+small values.\
+\>", "Text",
+ CellChangeTimes->{{3.540624693085382*^9, 3.5406247289244823`*^9}, {
+ 3.5406248163017282`*^9, 3.540624917261745*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{"Plot", "[", " ",
+ RowBox[{
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{"u", "/.",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], "\[Rule]", ".01"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], "->", "3"}]}], "}"}]}], ",",
+ RowBox[{"Log", "[",
+ RowBox[{"2", ",", "x"}], "]"}], ",", " ", "x"}], "}"}], ",",
+ RowBox[{"{",
+ RowBox[{"x", ",", "0", ",", "100"}], "}"}], ",",
+ RowBox[{"PlotStyle", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{"Red", ",", "Blue", ",", "Green"}], "}"}]}], ",",
+ RowBox[{"PlotRange", "\[Rule]",
+ RowBox[{"{",
+ RowBox[{"0", ",", "20"}], "}"}]}]}], "]"}]], "Input",
+ CellChangeTimes->{{3.5406243535636806`*^9, 3.5406244096271353`*^9}, {
+ 3.540624670184353*^9, 3.540624671231537*^9}, {3.540624734125123*^9,
+ 3.540624734432403*^9}, {3.540624796200985*^9, 3.540624806534687*^9}, {
+ 3.540624844102325*^9, 3.540624845507819*^9}}],
+
+Cell[BoxData[
+ GraphicsBox[{{}, {},
+ {RGBColor[1, 0, 0], LineBox[CompressedData["
+1:eJwV1Gs4lAkbB3DEOCwlKZlnZp4ph7AqZCni+dc6FDkuedLqoJhRyXlzjthe
+x0g5n9vQqsW2K1RILKlQePOGilIqbU1apojZeT/c1//6fbi/3Nf1v9d4B7j6
+SElISPiL5/+5NmPhlxJOm+WjuEzln88x0SCnS/rzS6nDUlzfDb8x0RZec1GH
+X0t5masXvWxg4pzJxI9KZxootwwyhnOLiU6DIB6D30otkV7/TrGLieiVokZR
+WTsVpuCrr9PDRE6WteXX9C5q6YA//7d+Ju6k9e+Y4fVR2jaOCZGjTAgSFSfD
+qx9SjJx18W/HmIhpr9UVlg1Q85EOb1gvxfuYrfmUPkS97WpmTb1jotssoekd
+7xn1bY9lduccE5e3roj9rnaMMvfUPzazwMTHkcOlodXjlFOudr6iJIFYptzz
+6bIXVF6Vecw8g0BuriPvQ/okVZCoYSCtQuDu2ZGg17wP1MBUnk+BFoGkvJzu
+c4YCyv2/nJyn6wjo8ynPTbUC6vOcjixTj0Cw7Nmo4OqPVGHSh2/DNxBYtDZu
+EZR9onR47pXDJgRWt0d+/3e6kAphpDCCbQjYNcs6vuKJqGS1oAtsbwKGIu+Z
+VQIRZZRif3TkEIE07v5eja0SsJB/FZ3tQyDU+3qYW4cE9E74PVrkE7B6FdhR
+PyiJw1EF9ZcCCDz/+8nB8JklyFptYecXTYC70FC0YCKHpJrAd5LnCaiW+AhW
+RsnhfPnmWX42ATlqhdWGVjl8zjZT6M0h8CHu+NQ+W3nILn8dmJVPoEVay+yW
+hwJC26yVZEoJeClmDZ0KV8Qdu4GU3F8J9CiZyEt7KePmxT3yBc0E+u1V8nqj
+lSHiRlhfbyHwv+T32vlFyljM5/k9biUwIVNltWFUGRqXNMJUbxP4uqAWR+9d
+jj7GMkFMJwG9919mr+xRgUJp0yS3T3zv3uYJ992qqLRU1Wx8RmB7hvWtKqfV
+GOhL3pW/SMBn45ySoRIXzLv6AUHGLDjo+nxcZauJlPTHgy08Fq4OxoR1b9bB
+mjslS55msWCuolcrfVIfT66Z7axrZoE3n1VcQRsgya11RcEECwGdk5tqHYyw
+uTLvRgmDjRRPhtbCMWMMpOx/fUyXjUNdUb6GfBOICq/4Wu5go01W3eXons2I
+edgdr+bDhuHyuJw3oWYYdhKoKSawceCThb7jsa0wbzrJGCtmo7zkL5Yw3RIR
+dU3Go01s/HHGbKTfFbCwMj3hPshG6HUL5+Jd2yChbxtr8o6N1rsV08l7t8Nc
+R++BgwwHfrZbmv3o7yGa1g5isDgoumRYf/SIFQqcitI+buLg7Kfm+MAT1qjs
+TuzrsOPgVXXYT/xgG9TNaugm7uegwyYr79QpWxwJKzsSGsaBpNPw84y4HVhS
+73svOJkDiW3XJMsidsL8i6ZZSREHSWpCh/7/2KFHkUiYqeMg0PPQbWGCPSBd
+mprczsF4vPFhKnsXfuo8WLVtiAPVc/nDyeUOmLolE2r6loNKZb2IrkJHSOU0
+qmXOc9AWTFqvu+yE2MhVEzJLSZRwy1gWbs5IaVR4IeCQaI6ek+A/cIbryfY0
+y40k1tjLftXwcMGcUed3F0Dizz7d1MeDLnjycN42x5lEWueiAdfLFZ3n9+nk
+HyRxLuTNkQOjrpjQ2mZjFkSK/w1n2do9P0CzJEvVNY7Er7oyd0PHfkCNqc7N
+oEwSjH8k1dv2ucEvc2WHVSmJKoPfY0sm3aDOTCDVa0noelc7Lvi7IzC+9y2/
+hcTIzqar7lPuOEh6DMXeJ9H/S+R6KmQ3ZituhmSMkPj8h8vWtdO7ceFFVUbA
+GxKixuD608c9kBU48fbJLAl7Axvr6BkPGHXzPMukuOjy2uh3NITG7zOa7yHP
+hcoh/o3iMBqbrbQ89om9j1+u9OAEjUTibEuU2LPBK64aR9Ogt1xJuia2ZpJw
+biGRRoXkrLy+AhdxV1vTMnNoFLAYbau+4cJM1rmuvonGo8dJUlOKXJxWTJZ6
+fYNGyM8HtsiJe/Nw+W03ZguNz3bVx7XE5rOMv8TepjE+fX5wv9i5hqu377hH
+o8Prfvqg2P/sHRsYHqWR2iCob17KBQ6qays9o/HMQGpwWOxUX9dwapxGyXyS
+QCj22qAO1sWXNBpchJpGy7hwOX3Jx/89Dd75H6MqxS5KHW8oFdAIWM9Jbxf7
+dSZToX+aRkTt7uIxseMK02pMhDSStqxvYipzcb/sLwm/LzQElfc6TMVWq1x0
+LZynwboz3usmtvdl04qeBRrlfQFDQWLX1AUKRSIaCoKwp2fE/hePQ/RA
+ "]]},
+ {RGBColor[0, 0, 1], LineBox[CompressedData["
+1:eJwt0nk01PsbB/DBYBBZBjPfpCmafsnFRJLo81ZJ1pD4Ii2iRiR73VKkiEbW
+knZaFCpdaRWVjKJIrjbq100prpNGYSwX1++c33POc97n9d/zPueZGbjdM1iW
+wWAcmNz/5Z0f0p+xDAlh/H9S8/PqcwUSsuX43716ddnEWEj8zMskRDksicOX
+XCNRitm7o0r6CG/H+z6+Uw0Zt7eolhT8IrMdQ9L2fGwhhdof3LL0+0n/r3XP
++XNekeWdyR9NT/WT7B6my4MNb4jowBvG9mMD5OCSQ+b0lXbCebxr2ffDUrI2
+xm1qctsnUplj0JquMkSmbRZfWdDUQdYFPg8yThsitWrdXcP3P5MLMvopoQeG
+idS6Wi4pvZMI8Ohp965RkqI7Os9/qIs4VSm6fd0yQXZNLahMnPWDCCYCB3Qk
+E8SyyGSmQvcPks5b32Rgw0BE3smhmd4SEhN4L9arlgHfMy5rSth9ZPnXiNqb
+rTJonufvbJP4k3R8/7Bx54AcvmSOVURTA+R1huhm1iImmreWFZYJB0iD6SKl
+4j1MsOapfOi8OUDKI49cfycvjxULg8f9XQfJvgGnCWsdBSxBQLBepJTwxm6f
+GrNkweNxu0Vx1jBhnwmWaO9m4Wyzk5XVy2HCIlrLTR6wENRuWcDWGCE/EsN7
+1jko4Y6pj7g2Y4RUM2dbP/RRxtPxmqHgpFESMCXnTdLOKfAUc7qjXMdIo6ql
+EjNAHez8wrP0UgZanDXzm+LVUXptnWcZzcDbtF7+8VPqaG84Oq09nIEv8peW
+m7xXR1/QhviKEwz8M6abSPtrwLc5dW+ChAGj3uHBK76aGO8VC/qPyCC1qerL
+Gm82ErHA8natLDKmnIjmxbFhGG323xuvZXHEKU625ygblmuiio90yeJsnQkv
+8RUbEX1RE3JT5HCr+qx/iZc25oneXznnIYfOa/taxj11wLbLP2rwVg5LM+0f
+XlrFwer9J+eotzKR6FRR3BLOQVej0fmWDiaq5Q1yxw5zsHhjuXdSHxPW8YzN
+q59zMBK3wKBETR7mIZUqEyu54Pus9OOtlIfhMoGP91IKSjbVgY235aEg1etl
+LtBDASOmyEakgOXlojemXnrQfhm0fvCYApK2jTz0i9aDZMvrGecuKGD885vc
+63/o4XODvKC5SgHS5pxFa02mY2JH0Z9pPxTQVcJKvjFHH+LCyE8id0UEm46o
+ClR54FflT09UYsGl/eBFjj4Pvz0tFRZqs2BxUNuWYcqDx50YmVszWWB+NAt7
+4c4DK+F28t1FLJzL2NKw7QgPdVrGJcYhLHz83ppSMm0mgmSX/HgrZsH3StmE
+gdEs7C1eFPktTgmuc4P7dBwMsSmayKjeV8aIKLbyg7cheim+C1OsjMu9yckX
+NhvitO7ai/2NymBWFHHnpxgiPCvp6sOPyri3pMvOVWyI0sxBa0U5FfC9QnP2
+L5uNW9N0TH1WqoCREGkuIXykaFjPsm9SQXnrnth6q/+gxrb1gWn9FCzWNCpj
+JhgjYN7q2LXFatgymnP6Im0G49N5VwtnqGN73TfzMtf5SK1oj79Rp45Dfgqz
+x8IskJPCPy4WamDTk92bBUJLxOexB9P6NPBIkesR6muFxQOOEjpMEwKNxLzu
+GGvYqdQHDH/VxIZftsZuYTaTf2zf1uGuhcIzYj3p4SVIMA9Vul2phRsZ1u0t
+nkDwwAyF3OlsxNyzdT/tYocRcqfFJ5qNBw0Xf6b5L4XILkND/RkbIQ6LqkLo
+Zeg5+nzrHo42Tl0W3AzduhxblCNfqAi1kf2ral/EDnt8redrzS/XxteS2Dhh
+1ArU571uM+rXRu2KnPykJAe8chz9tt9KBzKr2joyE1di9gnOpvxYHTDsbskU
+/O6Ik+LDNfplOkjVlbq2HHRCREVDjW6PDiL8NtVI9ztjsLy8rY+ni0/7LILI
+URcw1eS7jH11wc493pZW6Ir9n+3D1mfookjd6PcnJ91gErfHz7NaF4+iZtjP
+KV2F3oTYlDMSXZzhFejZerlDbXOehpY+B1XxIwxhszsOL9zE83DkYKaz4j8G
+Ph7YK3vi8rs4DipezBW9a/VA3um/i6gCDtLrxs14AZ5I3+33MPMZB7nR3Vs3
+vPeEw7ewUuYvDuK19afO8l2NS4E7gys4XBTPlW+I+Ws1HIVuLingQqFfhvto
+nRe6xQrF1UFcXDL7Y++Zb15wbWceZ4q4mBtY4ja2bQ0EtofmXSrjot3xbvma
+njXI4M5hKL7kouX8rt9ItDdMzqqoBvZzMXTDw2bWT28ECPH9ApvCxJ2omynh
+PpiwK1Y7YU7B2WyFffyAD8bC8wt3elF4EmAaEhpN4xz7MT8hioLmJmHl6Vga
+Lv9YvZWLprBOWKjavINGU3PtntRJD0ZplVvE0+hu5F/MjqFgmCodGTtAg/9m
+VfD5OAqJ5Q/Ss/JoHLTWvFq7i4K1ovv1m3dp9PCmhYwnUUiZkibbVUlDGiEs
+3LefwkuNGi+qmoar/NQm5gEKQj2L4b01NJwRwVRJpnBMwFm68hmN8br7nToH
+KfT7//Vn23sawylO8cYiCtjI5at+pCE33WD02qRFmz13kk80HjTGhgvSKcyK
+rNW70EmjozB7vuVhCh4pl4O39dLo7Go3I5kUTok+3T4roeFhXL360aS7sijl
+lp80Sh4ZhS7LmuxzMv2apZTGiV8lOxyyKTwvEDNChmkcPVYTVj9p3aJxz5Oj
+k/eeCvN2zqEQWLrwYuMYDQ6z1KJx0teuR0gnJmi8ak5QXJVL4V+ACJdb
+ "]]},
+ {RGBColor[0, 1, 0],
+ LineBox[{{2.040816326530612*^-6, 2.040816326530612*^-6}, {
+ 0.03067179205596268, 0.03067179205596268}, {0.06134154329559883,
+ 0.06134154329559883}, {0.12268104577487113`, 0.12268104577487113`}, {
+ 0.2453600507334157, 0.2453600507334157}, {0.4907180606505049,
+ 0.4907180606505049}, {0.9814340804846833, 0.9814340804846833}, {
+ 1.96286612015304, 1.96286612015304}, {4.090835708545865,
+ 4.090835708545865}, {6.07778835701521, 6.07778835701521}, {
+ 8.025764881887605, 8.025764881887605}, {10.138846915816112`,
+ 10.138846915816112`}, {12.110912009821138`, 12.110912009821138`}, {
+ 14.248082612882277`, 14.248082612882277`}, {16.346277092346465`,
+ 16.346277092346465`}, {18.303454631887174`, 18.303454631887174`}, {20.,
+ 20.}}]}},
+ AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948],
+ Axes->True,
+ AxesOrigin->{0, 0},
+ PlotRange->{{0, 100}, {0, 20}},
+ PlotRangeClipping->True,
+ PlotRangePadding->{
+ Scaled[0.02], Automatic}]], "Output",
+ CellChangeTimes->{{3.540624354626749*^9, 3.540624410273096*^9},
+ 3.540624672639637*^9, 3.540624735335573*^9, {3.540624800646563*^9,
+ 3.540624806947823*^9}, 3.5406248461654253`*^9, 3.5407063812065363`*^9}]
+}, Open ]],
+
+Cell["A template for the R code in the function:", "Text",
+ CellChangeTimes->{{3.5407065548336563`*^9, 3.540706563191538*^9}}],
+
+Cell[CellGroupData[{
+
+Cell[BoxData[
+ RowBox[{
+ RowBox[{"CForm", "[",
+ RowBox[{"FullSimplify", "[",
+ RowBox[{"u", ",",
+ RowBox[{"Assumptions", "->",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], ">", "0"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], ">", "0"}], ",",
+ RowBox[{"x", ">", "0"}]}], "}"}]}]}], "]"}], "]"}], "/.",
+ RowBox[{"{",
+ RowBox[{
+ RowBox[{
+ SubscriptBox["a", "0"], "\[Rule]", "asymptDisp"}], ",",
+ RowBox[{
+ SubscriptBox["a", "1"], "\[Rule]", "extraPois"}], ",",
+ RowBox[{"x", "\[Rule]", "q"}]}], "}"}]}]], "Input",
+ CellChangeTimes->{{3.540706440235935*^9, 3.54070654712416*^9}}],
+
+Cell["\<\
+Log((1 + extraPois + 2*asymptDisp*q +
+ 2*Sqrt(asymptDisp*q*(1 + extraPois + asymptDisp*q)))/
+ (4.*asymptDisp))/Log(2)\
+\>", "Output",
+ CellChangeTimes->{{3.5407064886833467`*^9, 3.540706495739716*^9}, {
+ 3.540706529058442*^9, 3.5407065480525093`*^9}}]
+}, Open ]],
+
+Cell[BoxData["\[IndentingNewLine]"], "Input",
+ CellChangeTimes->{3.5408157360105877`*^9}],
+
+Cell[BoxData[
+ StyleBox[
+ RowBox[{"For", " ", "local", " ", "dispersion", " ", "fit"}],
+ "Subsubtitle"]], "Input",
+ CellChangeTimes->{{3.540815731390847*^9, 3.540815731815278*^9}}],
+
+Cell[TextData[{
+ "In case of a local dispersion fit, the variance-stabilizing transformation ",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{
+ RowBox[{"u", "(", "x", ")"}], " ", "=",
+ RowBox[{
+ SuperscriptBox["\[Integral]", "x"],
+ FractionBox["d\[Mu]",
+ SqrtBox[
+ RowBox[{"v", "(", "\[Mu]", ")"}]]]}]}], TraditionalForm]]],
+ "is obtained by numerical integration of the fitted mean-dispersion relation \
+",
+ Cell[BoxData[
+ FormBox[
+ RowBox[{"v", "(", "\[Mu]", ")"}], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " (by adding up along a asinh-spaced grid and a fitting a spline). Then, the \
+scaling parameters \[Eta] and \[Xi] (see above) are chosen such that the VST \
+is equal to ",
+ Cell[BoxData[
+ FormBox[
+ SubscriptBox["log", "2"], TraditionalForm]],
+ FormatType->"TraditionalForm"],
+ " for two large normalized count values (for which the 95- and the \
+99.9-percentile of the sample-averaged normalized count values are used.)"
+}], "Text",
+ CellChangeTimes->{{3.540815740854124*^9, 3.540815862626584*^9}, {
+ 3.540815907181427*^9, 3.540816034208343*^9}, {3.540816089844325*^9,
+ 3.5408161426064177`*^9}, {3.5408161836470623`*^9, 3.540816250332963*^9}}]
+}, Open ]]
+},
+WindowSize->{640, 750},
+WindowMargins->{{148, Automatic}, {Automatic, 24}},
+PrintingPageRange->{Automatic, Automatic},
+PrintingOptions->{"Magnification"->1.,
+"PaperOrientation"->"Portrait",
+"PaperSize"->{594.3000000000001, 840.51},
+"PostScriptOutputFile"->"/home/anders/work/SVN/DESeq/inst/doc/vst.pdf"},
+FrontEndVersion->"7.0 for Linux x86 (64-bit) (February 25, 2009)",
+StyleDefinitions->"Default.nb"
+]
+(* End of Notebook Content *)
+
+(* Internal cache information *)
+(*CellTagsOutline
+CellTagsIndex->{}
+*)
+(*CellTagsIndex
+CellTagsIndex->{}
+*)
+(*NotebookFileOutline
+Notebook[{
+Cell[CellGroupData[{
+Cell[567, 22, 182, 2, 85, "Subtitle"],
+Cell[752, 26, 230, 5, 66, "Input"],
+Cell[985, 33, 431, 13, 71, "Text"],
+Cell[1419, 48, 92, 1, 32, "Input"],
+Cell[1514, 51, 575, 20, 51, "Text"],
+Cell[CellGroupData[{
+Cell[2114, 75, 330, 8, 32, "Input"],
+Cell[2447, 85, 234, 6, 47, "Output"]
+}, Open ]],
+Cell[2696, 94, 487, 19, 31, "Text"],
+Cell[3186, 115, 105, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[3316, 120, 255, 6, 32, "Input"],
+Cell[3574, 128, 305, 8, 33, "Output"]
+}, Open ]],
+Cell[3894, 139, 1272, 42, 145, "Text"],
+Cell[CellGroupData[{
+Cell[5191, 185, 768, 20, 61, "Input"],
+Cell[5962, 207, 679, 22, 72, "Output"]
+}, Open ]],
+Cell[6656, 232, 578, 20, 31, "Text"],
+Cell[CellGroupData[{
+Cell[7259, 256, 264, 6, 32, "Input"],
+Cell[7526, 264, 769, 24, 72, "Output"]
+}, Open ]],
+Cell[8310, 291, 437, 11, 51, "Text"],
+Cell[CellGroupData[{
+Cell[8772, 306, 515, 15, 32, "Input"],
+Cell[9290, 323, 301, 8, 52, "Output"]
+}, Open ]],
+Cell[9606, 334, 180, 4, 31, "Text"],
+Cell[CellGroupData[{
+Cell[9811, 342, 211, 6, 63, "Input"],
+Cell[10025, 350, 178, 5, 54, "Output"]
+}, Open ]],
+Cell[10218, 358, 139, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[10382, 363, 517, 15, 32, "Input"],
+Cell[10902, 380, 330, 10, 63, "Output"]
+}, Open ]],
+Cell[11247, 393, 92, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[11364, 398, 354, 11, 70, "Input"],
+Cell[11721, 411, 323, 10, 63, "Output"]
+}, Open ]],
+Cell[12059, 424, 123, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[12207, 429, 449, 14, 32, "Input"],
+Cell[12659, 445, 92, 1, 31, "Output"]
+}, Open ]],
+Cell[CellGroupData[{
+Cell[12788, 451, 517, 15, 32, "Input"],
+Cell[13308, 468, 96, 1, 31, "Output"]
+}, Open ]],
+Cell[13419, 472, 113, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[13557, 477, 434, 12, 32, "Input"],
+Cell[13994, 491, 695, 21, 68, "Output"]
+}, Open ]],
+Cell[14704, 515, 579, 19, 51, "Text"],
+Cell[CellGroupData[{
+Cell[15308, 538, 685, 20, 55, "Input"],
+Cell[15996, 560, 5767, 102, 227, "Output"]
+}, Open ]],
+Cell[21778, 665, 382, 7, 71, "Text"],
+Cell[CellGroupData[{
+Cell[22185, 676, 958, 25, 55, "Input"],
+Cell[23146, 703, 6513, 112, 256, "Output"]
+}, Open ]],
+Cell[29674, 818, 126, 1, 31, "Text"],
+Cell[CellGroupData[{
+Cell[29825, 823, 676, 20, 55, "Input"],
+Cell[30504, 845, 273, 6, 65, "Output"]
+}, Open ]],
+Cell[30792, 854, 89, 1, 55, "Input"],
+Cell[30884, 857, 183, 4, 37, "Input"],
+Cell[31070, 863, 1195, 29, 159, "Text"]
+}, Open ]]
+}
+]
+*)
+
+(* End of internal cache information *)
diff --git a/vignettes/vst.pdf b/vignettes/vst.pdf
new file mode 100644
index 0000000..17f55b4
Binary files /dev/null and b/vignettes/vst.pdf differ
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-bioc-deseq2.git
More information about the debian-med-commit
mailing list