[med-svn] [r-bioc-qvalue] 02/05: New upstream version 2.10.0
Andreas Tille
tille at debian.org
Sat Nov 11 07:43:12 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-bioc-qvalue.
commit 8e5a846739afb12a341d7edbd47e391e9912ef8c
Author: Andreas Tille <tille at debian.org>
Date: Sat Nov 11 08:37:54 2017 +0100
New upstream version 2.10.0
---
DESCRIPTION | 4 ++--
R/hist_qvalue.R | 2 +-
R/lfdr.R | 10 +++-------
R/pi0est.R | 10 ++++++----
R/qvalue.R | 38 ++++++++++++++++++++++++++------------
build/vignette.rds | Bin 196 -> 198 bytes
inst/doc/qvalue.pdf | Bin 272430 -> 271920 bytes
man/empPvals.Rd | 7 +++----
man/hedenfalk.Rd | 1 -
man/hist.qvalue.Rd | 9 ++++-----
man/lfdr.Rd | 7 +++----
man/pi0est.Rd | 7 +++----
man/plot.qvalue.Rd | 9 ++++-----
man/qvalue.Rd | 15 ++++++++++-----
man/summary.qvalue.Rd | 9 ++++-----
man/write.qvalue.Rd | 7 +++----
16 files changed, 72 insertions(+), 63 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
old mode 100755
new mode 100644
index 82924a5..1e17282
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: qvalue
Type: Package
Title: Q-value estimation for false discovery rate control
-Version: 2.8.0
+Version: 2.10.0
Date: 2015-03-24
Author: John D. Storey with contributions from Andrew J. Bass, Alan Dabney and
David Robinson
@@ -29,4 +29,4 @@ URL: http://github.com/jdstorey/qvalue
License: LGPL
RoxygenNote: 5.0.1
NeedsCompilation: no
-Packaged: 2017-04-24 22:26:28 UTC; biocbuild
+Packaged: 2017-10-30 22:38:17 UTC; biocbuild
diff --git a/R/hist_qvalue.R b/R/hist_qvalue.R
index 3de6943..efb2db6 100644
--- a/R/hist_qvalue.R
+++ b/R/hist_qvalue.R
@@ -68,7 +68,7 @@ hist.qvalue <- function(x, ...) {
ggplot(dm, aes_string(x = 'pvals')) +
ggtitle("p-value density histogram") +
geom_histogram(aes_string(y = '..density..'), colour = "black",
- fill = "white", binwidth = 0.04) +
+ fill = "white", binwidth = 0.04, center=0.02) +
coord_cartesian(xlim = c(0, 1)) +
geom_line(aes_string(x = 'pvals', y = 'value', color = 'variable', linetype = 'variable'), size = 1.1) +
scale_linetype_manual(name = "Variables",
diff --git a/R/lfdr.R b/R/lfdr.R
index d1f9159..cd21d8e 100644
--- a/R/lfdr.R
+++ b/R/lfdr.R
@@ -88,13 +88,9 @@ lfdr <- function(p, pi0 = NULL, trunc = TRUE, monotone = TRUE,
lfdr[lfdr > 1] <- 1
}
if (monotone) {
- lfdr <- lfdr[order(p)]
- for (i in 2:n) {
- if (lfdr[i] < lfdr[i - 1]) {
- lfdr[i] <- lfdr[i - 1]
- }
- }
- lfdr <- lfdr[rank(p)]
+ o <- order(p, decreasing = FALSE)
+ ro <- order(o)
+ lfdr <- cummax(lfdr[o])[ro]
}
lfdr_out[rm_na] <- lfdr
return(lfdr_out)
diff --git a/R/pi0est.R b/R/pi0est.R
index f944213..df7675e 100644
--- a/R/pi0est.R
+++ b/R/pi0est.R
@@ -89,9 +89,9 @@ pi0est <- function(p, lambda = seq(0.05,0.95,0.05), pi0.method = c("smoother", "
if (min(p) < 0 || max(p) > 1) {
stop("ERROR: p-values not in valid range [0, 1].")
} else if (ll > 1 && ll < 4) {
- stop(cat("ERROR:", paste("length(lambda)=", ll, ".", sep=""),
+ stop(sprintf(paste("ERROR:", paste("length(lambda)=", ll, ".", sep=""),
"If length of lambda greater than 1,",
- "you need at least 4 values."))
+ "you need at least 4 values.")))
} else if (min(lambda) < 0 || max(lambda) >= 1) {
stop("ERROR: Lambda must be within [0, 1).")
}
@@ -102,8 +102,10 @@ pi0est <- function(p, lambda = seq(0.05,0.95,0.05), pi0.method = c("smoother", "
pi0 <- min(pi0, 1)
pi0Smooth <- NULL
} else {
- pi0 <- sapply(lambda, function(l) mean(p >= l) / (1 - l))
- pi0.lambda <- pi0
+ ind <- length(lambda):1
+ pi0 <- cumsum(tabulate(findInterval(p, vec=lambda))[ind]) / (length(p) * (1-lambda[ind]))
+ pi0 <- pi0[ind]
+ pi0.lambda <- pi0
# Smoother method approximation
if (pi0.method == "smoother") {
if (smooth.log.pi0) {
diff --git a/R/qvalue.R b/R/qvalue.R
index 3c4b000..c258a18 100755
--- a/R/qvalue.R
+++ b/R/qvalue.R
@@ -19,7 +19,11 @@
#' whether each q-value is less than fdr.level or not.
#' @param pfdr An indicator of whether it is desired to make the
#' estimate more robust for small p-values and a direct finite sample estimate of pFDR -- optional.
+#' @param lfdr.out If TRUE then local false discovery rates are returned. Default is TRUE.
+#' @param pi0 It is recommended to not input an estimate of pi0. Experienced users can use their own methodology to estimate
+#' the proportion of true nulls or set it equal to 1 for the BH procedure.
#' @param \ldots Additional arguments passed to \code{\link{pi0est}} and \code{\link{lfdr}}.
+#'
#'
#' @return
#' A list of object type "qvalue" containing:
@@ -80,7 +84,7 @@
#' @import splines ggplot2 reshape2
#' @importFrom grid grid.newpage pushViewport viewport grid.layout
#' @export
-qvalue <- function(p, fdr.level = NULL, pfdr = FALSE, ...) {
+qvalue <- function(p, fdr.level = NULL, pfdr = FALSE, lfdr.out = TRUE, pi0 = NULL, ...) {
# Argument checks
p_in <- qvals_out <- lfdr_out <- p
rm_na <- !is.na(p)
@@ -92,25 +96,35 @@ qvalue <- function(p, fdr.level = NULL, pfdr = FALSE, ...) {
}
# Calculate pi0 estimate
- pi0s <- pi0est(p, ...)
+ if (is.null(pi0)) {
+ pi0s <- pi0est(p, ...)
+ } else {
+ if (pi0 > 0 && pi0 <= 1) {
+ pi0s = list()
+ pi0s$pi0 = pi0
+ } else {
+ stop("pi0 is not (0,1]")
+ }
+ }
# Calculate q-value estimates
m <- length(p)
- u <- order(p)
- v <- rank(p, ties.method="max")
+ i <- m:1L
+ o <- order(p, decreasing = TRUE)
+ ro <- order(o)
if (pfdr) {
- qvals <- (pi0s$pi0 * m * p) / (v * (1 - (1 - p) ^ m))
+ qvals <- pi0s$pi0 * pmin(1, cummin(p[o] * m / (i * (1 - (1 - p[o]) ^ m))))[ro]
} else {
- qvals <- (pi0s$pi0 * m * p) / v
- }
- qvals[u[m]] <- min(qvals[u[m]], 1)
- for (i in (m - 1):1) {
- qvals[u[i]] <- min(qvals[u[i]], qvals[u[i + 1]])
+ qvals <- pi0s$pi0 * pmin(1, cummin(p[o] * m /i ))[ro]
}
qvals_out[rm_na] <- qvals
# Calculate local FDR estimates
- lfdr <- lfdr(p = p, pi0 = pi0s$pi0, ...)
- lfdr_out[rm_na] <- lfdr
+ if (lfdr.out) {
+ lfdr <- lfdr(p = p, pi0 = pi0s$pi0, ...)
+ lfdr_out[rm_na] <- lfdr
+ } else {
+ lfdr_out <- NULL
+ }
# Return results
if (!is.null(fdr.level)) {
diff --git a/build/vignette.rds b/build/vignette.rds
index 9a5226c..26ebd86 100644
Binary files a/build/vignette.rds and b/build/vignette.rds differ
diff --git a/inst/doc/qvalue.pdf b/inst/doc/qvalue.pdf
index 51cb174..1ee934b 100644
Binary files a/inst/doc/qvalue.pdf and b/inst/doc/qvalue.pdf differ
diff --git a/man/empPvals.Rd b/man/empPvals.Rd
index 3deb86b..cd1d308 100644
--- a/man/empPvals.Rd
+++ b/man/empPvals.Rd
@@ -58,9 +58,6 @@ p.testspecific <- empPvals(stat=stat, stat0=stat0, pool=FALSE)
qqplot(p.pooled, p.testspecific); abline(0,1)
}
-\author{
-John D. Storey
-}
\references{
Storey JD and Tibshirani R. (2003) Statistical significance for
genome-wide experiments. Proceedings of the National Academy of Sciences,
@@ -74,5 +71,7 @@ Storey JD and Tibshirani R. (2003) Statistical significance for
\seealso{
\code{\link{qvalue}}
}
+\author{
+John D. Storey
+}
\keyword{pvalues}
-
diff --git a/man/hedenfalk.Rd b/man/hedenfalk.Rd
index 5546571..b65b971 100644
--- a/man/hedenfalk.Rd
+++ b/man/hedenfalk.Rd
@@ -59,4 +59,3 @@ studies. Proceedings of the National Academy of Sciences, 100: 9440-9445. \cr
}
\keyword{dataset,}
\keyword{hedenfalk}
-
diff --git a/man/hist.qvalue.Rd b/man/hist.qvalue.Rd
index 91979f8..c0197e4 100644
--- a/man/hist.qvalue.Rd
+++ b/man/hist.qvalue.Rd
@@ -1,8 +1,8 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/hist_qvalue.R
\name{hist.qvalue}
-\alias{hist,}
\alias{hist.qvalue}
+\alias{hist,}
\title{Histogram of p-values}
\usage{
\method{hist}{qvalue}(x, ...)
@@ -33,9 +33,6 @@ qobj <- qvalue(p)
hist(qobj)
}
-\author{
-Andrew J. Bass
-}
\references{
Storey JD. (2002) A direct approach to false discovery rates. Journal
of the Royal Statistical Society, Series B, 64: 479-498. \cr
@@ -62,5 +59,7 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\seealso{
\code{\link{qvalue}}, \code{\link{plot.qvalue}}, \code{\link{summary.qvalue}}
}
+\author{
+Andrew J. Bass
+}
\keyword{histogram}
-
diff --git a/man/lfdr.Rd b/man/lfdr.Rd
index b8f14b0..895ff5f 100644
--- a/man/lfdr.Rd
+++ b/man/lfdr.Rd
@@ -53,9 +53,6 @@ qobj = qvalue(p)
hist(qobj)
}
-\author{
-John D. Storey
-}
\references{
Efron B, Tibshirani R, Storey JD, and Tisher V. (2001) Empirical Bayes analysis
of a microarray experiment. Journal of the American Statistical Association, 96: 1151-1160. \cr
@@ -72,9 +69,11 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\seealso{
\code{\link{qvalue}}, \code{\link{pi0est}}, \code{\link{hist.qvalue}}
}
+\author{
+John D. Storey
+}
\keyword{Discovery}
\keyword{False}
\keyword{Rate,}
\keyword{lfdr}
\keyword{local}
-
diff --git a/man/pi0est.Rd b/man/pi0est.Rd
index cb2439d..b3fb491 100644
--- a/man/pi0est.Rd
+++ b/man/pi0est.Rd
@@ -63,9 +63,6 @@ hist(qobj)
plot(qobj)
}
-\author{
-John D. Storey
-}
\references{
Storey JD. (2002) A direct approach to false discovery rates. Journal
of the Royal Statistical Society, Series B, 64: 479-498. \cr
@@ -92,8 +89,10 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\seealso{
\code{\link{qvalue}}
}
+\author{
+John D. Storey
+}
\keyword{nulls}
\keyword{pi0est,}
\keyword{proportion}
\keyword{true}
-
diff --git a/man/plot.qvalue.Rd b/man/plot.qvalue.Rd
index cb6a796..8f62a62 100644
--- a/man/plot.qvalue.Rd
+++ b/man/plot.qvalue.Rd
@@ -1,8 +1,8 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plot_qvalue.R
\name{plot.qvalue}
-\alias{plot,}
\alias{plot.qvalue}
+\alias{plot,}
\title{Plotting function for q-value object}
\usage{
\method{plot}{qvalue}(x, rng = c(0, 0.1), ...)
@@ -52,9 +52,6 @@ qobj <- qvalue(p)
plot(qobj, rng=c(0.0, 0.3))
}
-\author{
-John D. Storey, Andrew J. Bass
-}
\references{
Storey JD. (2002) A direct approach to false discovery rates. Journal
of the Royal Statistical Society, Series B, 64: 479-498. \cr
@@ -81,5 +78,7 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\seealso{
\code{\link{qvalue}}, \code{\link{write.qvalue}}, \code{\link{summary.qvalue}}
}
+\author{
+John D. Storey, Andrew J. Bass
+}
\keyword{plot}
-
diff --git a/man/qvalue.Rd b/man/qvalue.Rd
index 2df566d..5be5495 100644
--- a/man/qvalue.Rd
+++ b/man/qvalue.Rd
@@ -4,7 +4,8 @@
\alias{qvalue}
\title{Estimate the q-values for a given set of p-values}
\usage{
-qvalue(p, fdr.level = NULL, pfdr = FALSE, ...)
+qvalue(p, fdr.level = NULL, pfdr = FALSE, lfdr.out = TRUE, pi0 = NULL,
+ ...)
}
\arguments{
\item{p}{A vector of p-values (only necessary input).}
@@ -16,6 +17,11 @@ whether each q-value is less than fdr.level or not.}
\item{pfdr}{An indicator of whether it is desired to make the
estimate more robust for small p-values and a direct finite sample estimate of pFDR -- optional.}
+\item{lfdr.out}{If TRUE then local false discovery rates are returned. Default is TRUE.}
+
+\item{pi0}{It is recommended to not input an estimate of pi0. Experienced users can use their own methodology to estimate
+the proportion of true nulls or set it equal to 1 for the BH procedure.}
+
\item{\ldots}{Additional arguments passed to \code{\link{pi0est}} and \code{\link{lfdr}}.}
}
\value{
@@ -58,9 +64,6 @@ qobj <- qvalue(p, lambda=0.5, pfdr=TRUE)
qobj <- qvalue(p, fdr.level=0.05, pi0.method="bootstrap", adj=1.2)
}
-\author{
-John D. Storey
-}
\references{
Storey JD. (2002) A direct approach to false discovery rates. Journal
of the Royal Statistical Society, Series B, 64: 479-498. \cr
@@ -88,5 +91,7 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\code{\link{pi0est}}, \code{\link{lfdr}}, \code{\link{summary.qvalue}},
\code{\link{plot.qvalue}}, \code{\link{hist.qvalue}}, \code{\link{write.qvalue}}
}
+\author{
+John D. Storey
+}
\keyword{qvalue}
-
diff --git a/man/summary.qvalue.Rd b/man/summary.qvalue.Rd
index 4bfe9e6..5c62f1a 100644
--- a/man/summary.qvalue.Rd
+++ b/man/summary.qvalue.Rd
@@ -1,8 +1,8 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summary_qvalue.R
\name{summary.qvalue}
-\alias{summary,}
\alias{summary.qvalue}
+\alias{summary,}
\title{Display q-value object}
\usage{
\method{summary}{qvalue}(object, cuts = c(1e-04, 0.001, 0.01, 0.025, 0.05,
@@ -39,9 +39,6 @@ qobj <- qvalue(p)
summary(qobj, cuts=c(0.01, 0.05))
}
-\author{
-John D. Storey, Andrew J. Bass, Alan Dabney
-}
\references{
Storey JD. (2002) A direct approach to false discovery rates. Journal
of the Royal Statistical Society, Series B, 64: 479-498. \cr
@@ -69,5 +66,7 @@ Storey JD. (2011) False discovery rates. In \emph{International Encyclopedia of
\seealso{
\code{\link{qvalue}}, \code{\link{plot.qvalue}}, \code{\link{write.qvalue}}
}
+\author{
+John D. Storey, Andrew J. Bass, Alan Dabney
+}
\keyword{summary}
-
diff --git a/man/write.qvalue.Rd b/man/write.qvalue.Rd
index 4d669ae..05abbdb 100644
--- a/man/write.qvalue.Rd
+++ b/man/write.qvalue.Rd
@@ -44,12 +44,11 @@ p <- hedenfalk$p
qobj <- qvalue(p)
write.qvalue(qobj, file="myresults.txt")
}
-\author{
-John D. Storey, Andrew J. Bass
-}
\seealso{
\code{\link{qvalue}}, \code{\link{plot.qvalue}},
\code{\link{summary.qvalue}}
}
+\author{
+John D. Storey, Andrew J. Bass
+}
\keyword{write.qvalue}
-
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-bioc-qvalue.git
More information about the debian-med-commit
mailing list