[Robast-commits] r289 - in pkg/RobLoxBioC: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 21 06:34:21 CEST 2009
Author: stamats
Date: 2009-04-21 06:34:19 +0200 (Tue, 21 Apr 2009)
New Revision: 289
Modified:
pkg/RobLoxBioC/DESCRIPTION
pkg/RobLoxBioC/R/robloxbiocAffyBatch.R
pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R
pkg/RobLoxBioC/R/robloxbiocMatrix.R
pkg/RobLoxBioC/R/sysdata.rda
pkg/RobLoxBioC/inst/NEWS
pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd
pkg/RobLoxBioC/man/robloxbioc.Rd
Log:
added finite-sample correction, handle n <= 2, eps = 0
Modified: pkg/RobLoxBioC/DESCRIPTION
===================================================================
--- pkg/RobLoxBioC/DESCRIPTION 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/DESCRIPTION 2009-04-21 04:34:19 UTC (rev 289)
@@ -1,6 +1,6 @@
Package: RobLoxBioC
-Version: 0.3
-Date: 2009-04-08
+Version: 0.4
+Date: 2009-04-21
Title: Infinitesimally robust estimators for preprocessing omics data
Description: Functions for the determination of optimally robust
influence curves and estimators for preprocessing omics data,
Modified: pkg/RobLoxBioC/R/robloxbiocAffyBatch.R
===================================================================
--- pkg/RobLoxBioC/R/robloxbiocAffyBatch.R 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/R/robloxbiocAffyBatch.R 2009-04-21 04:34:19 UTC (rev 289)
@@ -5,7 +5,8 @@
function(x, bg.correct = TRUE, pmcorrect = TRUE, normalize = FALSE,
add.constant = 32, verbose = TRUE,
eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L,
- mad0 = 1e-4, contrast.tau = 0.03, scale.tau = 10, delta = 2^(-20), sc = 500) {
+ fsCor = TRUE, mad0 = 1e-4, contrast.tau = 0.03, scale.tau = 10,
+ delta = 2^(-20), sc = 500) {
if(bg.correct){
if(verbose) cat("Background correcting ...")
x <- affy::bg.correct.mas(x, griddim = 16)
@@ -39,7 +40,7 @@
temp <- matrix(do.call(rbind, res[ind]), nrow = k)
ind1 <- as.vector(sapply(seq_len(n)-1, function(x, ind, m){ ind + x*m }, ind = ind, m = m))
rob.est1[ind1, 1:2] <- robloxbioc(t(temp), eps = eps, eps.lower = eps.lower, eps.upper = eps.upper,
- steps = steps, mad0 = mad0)
+ steps = steps, fsCor = fsCor, mad0 = mad0)
}
sb <- matrix(rob.est1[,1], nrow = m)
for(k in seq_len(m)){
@@ -78,7 +79,8 @@
temp <- matrix(do.call(rbind, res[ind]), nrow = k)
ind1 <- as.vector(sapply(seq_len(n)-1, function(x, ind, m){ ind + x*m }, ind = ind, m = m))
rob.est[ind1, 1:2] <- robloxbioc(log2(t(temp)), eps = eps, eps.lower = eps.lower,
- eps.upper = eps.upper, steps = steps, mad0 = mad0)
+ eps.upper = eps.upper, steps = steps, fsCor = fsCor,
+ mad0 = mad0)
rob.est[ind1, 2] <- rob.est[ind1, 2]/sqrt(k)
}
if(verbose) cat(" done.\n")
Modified: pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R
===================================================================
--- pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R 2009-04-21 04:34:19 UTC (rev 289)
@@ -1,6 +1,7 @@
setMethod("robloxbioc", signature(x = "BeadLevelList"),
function(x, log = FALSE, imagesPerArray = 1, what = "G", probes = NULL, arrays = NULL,
- eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L, mad0 = 1e-4){
+ eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L,
+ fsCor = TRUE, mad0 = 1e-4){
BLData <- x
arraynms <- arrayNames(BLData)
if(!is.null(arrays) && !is.character(arrays)) arraynms <- arraynms[arrays]
@@ -73,7 +74,7 @@
start <- 0
blah <- rmxBeadSummary(x = finten, probeIDs = probeIDs, probes = probes,
eps = eps, eps.lower = eps.lower, eps.upper = eps.upper,
- steps = steps, mad0 = mad0)
+ steps = steps, fsCor = fsCor, mad0 = mad0)
G[, i] <- blah$fore
GBeadStDev[, i] <- blah$sd
GNoBeads[, i] <- blah$noBeads
@@ -91,7 +92,7 @@
}
blah <- rmxBeadSummary(x = finten, probeIDs = probeIDs, probes = probes,
eps = eps, eps.lower = eps.lower, eps.upper = eps.upper,
- steps = steps, mad0 = mad0)
+ steps = steps, fsCor = fsCor, mad0 = mad0)
R[, i] <- blah$fore
RBeadStDev[, i] <- blah$sd
RNoBeads[, i] <- blah$noBeads
@@ -155,7 +156,7 @@
BSData
})
## computation of bead summaries via robloxbioc for "matrix"
-rmxBeadSummary <- function(x, probeIDs, probes, eps, eps.lower, eps.upper, steps, mad0){
+rmxBeadSummary <- function(x, probeIDs, probes, eps, eps.lower, eps.upper, steps, fsCor, mad0){
comIDs <- intersect(probeIDs, probes)
x <- x[probeIDs %in% comIDs]
probeIDs <- probeIDs[probeIDs %in% comIDs]
@@ -174,7 +175,7 @@
}else{
temp <- matrix(x[probeIDs %in% IDs], ncol = noBeads.uni[i], byrow = TRUE)
rmx <- robloxbioc(temp, eps = eps, eps.lower = eps.lower, eps.upper = eps.upper,
- steps = steps, mad0 = mad0)
+ steps = steps, fsCor = fsCor, mad0 = mad0)
fore1[index] <- rmx[,"mean"]
SD1[index] <- rmx[,"sd"]
}
Modified: pkg/RobLoxBioC/R/robloxbiocMatrix.R
===================================================================
--- pkg/RobLoxBioC/R/robloxbiocMatrix.R 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/R/robloxbiocMatrix.R 2009-04-21 04:34:19 UTC (rev 289)
@@ -3,8 +3,17 @@
## matrix
###############################################################################
setMethod("robloxbioc", signature(x = "matrix"),
- function(x, eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L, mad0 = 1e-4){
+ function(x, eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L,
+ fsCor = TRUE, mad0 = 1e-4){
stopifnot(is.numeric(x))
+ if(ncol(x) <= 2){
+ warning("Sample size <= 2! => Median and MAD are used for estimation.")
+ mean <- rowMedians(x, na.rm = TRUE)
+ sd <- rowMedians(abs(x-mean), na.rm = TRUE)/qnorm(0.75)
+ robEst <- cbind(mean, sd)
+ colnames(robEst) <- c("mean", "sd")
+ return(robEst)
+ }
if(is.null(eps)){
if(length(eps.lower) != 1 || length(eps.upper) != 1)
stop("'eps.lower' and 'eps.upper' have to be of length 1")
@@ -19,10 +28,18 @@
}
if(!is.numeric(eps))
stop("'eps' has to be a double in (0, 0.5]")
- if(eps == 0)
- stop("'eps = 0'! => use functions 'mean' and 'sd' for estimation")
if((eps < 0) || (eps > 0.5))
stop("'eps' has to be in (0, 0.5]")
+ if(eps == 0){
+ warning("eps = 0! => Mean and sd are used for estimation.")
+ mean <- rowMeans(x, na.rm = TRUE)
+ n <- rowSums(!is.na(x))
+ n[n < 1] <- NA
+ sd <- rowSums((x - mean)^2, na.rm = TRUE)/n
+ robEst <- cbind(mean, sd)
+ colnames(robEst) <- c("mean", "sd")
+ return(robEst)
+ }
}
if(length(steps) != 1){
warning("'steps' has to be of length 1 => only first element is used!")
@@ -30,7 +47,6 @@
}
if(steps < 1)
stop("'steps' has to be some positive integer value")
-
steps <- as.integer(steps)
mean <- rowMedians(x, na.rm = TRUE)
@@ -42,6 +58,7 @@
if(!is.null(eps)){
r <- sqrt(ncol(x))*eps
+ if(fsCor) r <- .finiteSampleCorrection(r = r, n = ncol(x))
if(r > 10){
b <- sd*1.618128043
const <- 1.263094656
@@ -69,6 +86,7 @@
r <- uniroot(.getlsInterval, lower = rlo+1e-8, upper = rup,
tol = .Machine$double.eps^0.25, rlo = rlo, rup = rup)$root
}
+ if(fsCor) r <- .finiteSampleCorrection(r = r, n = ncol(x))
if(r > 10){
b <- sd*1.618128043
const <- 1.263094656
@@ -134,3 +152,17 @@
return(est)
}
+.finiteSampleCorrection <- function(r, n){
+ if(r >= 1.74) return(r)
+
+ eps <- r/sqrt(n)
+ ns <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10),
+ seq(250, 500, by = 50))
+ epss <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+ if(n %in% ns){
+ ind <- ns == n
+ }else{
+ ind <- which.min(abs(ns-n))
+ }
+ return(max(r, approx(x = epss, y = .finiteSampleRadius.locsc[,ind], xout = eps, rule = 2)$y))
+}
Modified: pkg/RobLoxBioC/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: pkg/RobLoxBioC/inst/NEWS
===================================================================
--- pkg/RobLoxBioC/inst/NEWS 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/inst/NEWS 2009-04-21 04:34:19 UTC (rev 289)
@@ -3,16 +3,23 @@
###############################################################################
#######################################
-version 0.1
+version 0.4
#######################################
-+ start of development
++ added finite-sample correction
++ handle cases with sample size <= 2 and contamination eps = 0
#######################################
+version 0.3
+#######################################
++ added KolmogorovMinDist methods for matrix, AffyBatch and BeadLevelList
+
+#######################################
version 0.2
#######################################
+ robloxbioc methods for AffyBatch and BeadLevelList
#######################################
-version 0.3
+version 0.1
#######################################
-+ added KolmogorovMinDist methods for matrix, AffyBatch and BeadLevelList
++ start of development
+
Modified: pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd
===================================================================
--- pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd 2009-04-21 04:34:19 UTC (rev 289)
@@ -12,8 +12,8 @@
\details{
\tabular{ll}{
Package: \tab RobLoxBioC\cr
-Version: \tab 0.3 \cr
-Date: \tab 2009-04-08 \cr
+Version: \tab 0.4 \cr
+Date: \tab 2009-04-21 \cr
Depends: \tab R (>= 2.8.1), methods, Biobase, affy, beadarray, distr\cr
LazyLoad: \tab yes\cr
License: \tab LGPL-3\cr
Modified: pkg/RobLoxBioC/man/robloxbioc.Rd
===================================================================
--- pkg/RobLoxBioC/man/robloxbioc.Rd 2009-04-21 04:13:34 UTC (rev 288)
+++ pkg/RobLoxBioC/man/robloxbioc.Rd 2009-04-21 04:34:19 UTC (rev 289)
@@ -14,16 +14,17 @@
robloxbioc(x, ...)
\S4method{robloxbioc}{matrix}(x, eps = NULL, eps.lower = 0, eps.upper = 0.1, steps = 3L,
- mad0 = 1e-4)
+ fsCor = TRUE, mad0 = 1e-4)
\S4method{robloxbioc}{AffyBatch}(x, bg.correct = TRUE, pmcorrect = TRUE, normalize = FALSE,
add.constant = 32, verbose = TRUE, eps = NULL,
- eps.lower = 0, eps.upper = 0.1, steps = 3L, mad0 = 1e-4,
- contrast.tau = 0.03, scale.tau = 10, delta = 2^(-20), sc = 500)
+ eps.lower = 0, eps.upper = 0.1, steps = 3L, fsCor = TRUE,
+ mad0 = 1e-4, contrast.tau = 0.03, scale.tau = 10,
+ delta = 2^(-20), sc = 500)
\S4method{robloxbioc}{BeadLevelList}(x, log = FALSE, imagesPerArray = 1, what = "G", probes = NULL,
arrays = NULL, eps = NULL, eps.lower = 0, eps.upper = 0.1,
- steps = 3L, mad0 = 1e-4)
+ steps = 3L, fsCor = TRUE, mad0 = 1e-4)
}
\arguments{
\item{x}{ biological data. }
@@ -35,6 +36,7 @@
\item{eps.upper}{ positive real (\code{eps.lower} <= \code{eps.upper} <= 0.5):
upper bound for the amount of gross errors. See details below. }
\item{steps}{ positive integer. k-step is used to compute the optimally robust estimator. }
+ \item{fsCor}{ logical: perform finite-sample correction. See function \code{\link[RobLox]{finiteSampleCorrection}}. }
\item{mad0}{ scale estimate used if computed MAD is equal to zero}
\item{bg.correct}{ if \code{TRUE} MAS 5.0 background correction is performed;
confer \code{\link[affy]{bg.correct.mas}}. }
@@ -90,6 +92,10 @@
In case of Illumina data, the rmx estimator is used to summarize the bead types.
The implementation for the most part was taken from function
\code{\link[beadarray]{createBeadSummaryData}}.
+
+ For sample size <= 2, median and/or MAD are used for estimation.
+
+ If \code{eps = 0}, mean and/or sd are computed.
}
\value{ Return value depends on the class of \code{x}.
In case of \code{"matrix"} a matrix with columns "mean" and "sd" is returned.
More information about the Robast-commits
mailing list