[Robast-commits] r69 - in pkg/RobLox: . R inst/tests man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 22 12:55:48 CET 2008
Author: stamats
Date: 2008-02-22 12:55:48 +0100 (Fri, 22 Feb 2008)
New Revision: 69
Added:
pkg/RobLox/R/colRoblox.R
pkg/RobLox/R/rowRoblox.R
pkg/RobLox/man/rowRoblox.Rd
Modified:
pkg/RobLox/NAMESPACE
pkg/RobLox/R/roblox.R
pkg/RobLox/inst/tests/tests.R
pkg/RobLox/man/roblox.Rd
Log:
corrected some small errors and added rowRoblox and colRoblox.
Modified: pkg/RobLox/NAMESPACE
===================================================================
--- pkg/RobLox/NAMESPACE 2008-02-22 10:01:13 UTC (rev 68)
+++ pkg/RobLox/NAMESPACE 2008-02-22 11:55:48 UTC (rev 69)
@@ -18,4 +18,6 @@
rlsOptIC.MM2,
rlOptIC,
rsOptIC,
- roblox)
+ roblox,
+ rowRoblox,
+ colRoblox)
Added: pkg/RobLox/R/colRoblox.R
===================================================================
--- pkg/RobLox/R/colRoblox.R (rev 0)
+++ pkg/RobLox/R/colRoblox.R 2008-02-22 11:55:48 UTC (rev 69)
@@ -0,0 +1,13 @@
+###############################################################################
+## Evaluate roblox on columns of a matrix
+###############################################################################
+colRoblox <- function(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1){
+ if(missing(x))
+ stop("'x' is missing with no default")
+ x <- as.matrix(x)
+ if(!is.matrix(x))
+ stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'")
+
+ return(rowRoblox(x = t(x), mean = mean, sd = sd, eps = eps, eps.lower = eps.lower,
+ eps.upper = eps.upper, initial.est = initial.est, k = k))
+}
Modified: pkg/RobLox/R/roblox.R
===================================================================
--- pkg/RobLox/R/roblox.R 2008-02-22 10:01:13 UTC (rev 68)
+++ pkg/RobLox/R/roblox.R 2008-02-22 11:55:48 UTC (rev 69)
@@ -108,7 +108,7 @@
}
.onestep.sc <- function(x, initial.est, A, a, b, mean){
v <- A*(((x-mean)/initial.est)^2-1)/initial.est - a
- IC <- mean(v*pmin(1, b/abs(v)))
+ IC <- mean(v*pmin(1, b/abs(v)), na.rm = TRUE)
return(initial.est + IC)
}
.kstep.sc <- function(x, initial.est, A, a, b, mean, k){
@@ -132,7 +132,7 @@
u <- A1*(x-mean)/sd^2
v <- A2*(((x-mean)/sd)^2-1)/sd - a[2]
w <- pmin(1, b/sqrt(u^2 + v^2))
- IC <- c(mean(u*w), mean(v*w))
+ IC <- c(mean(u*w, na.rm = TRUE), mean(v*w, na.rm = TRUE))
return(initial.est + IC)
}
.kstep.locsc <- function(x, initial.est, A1, A2, a, b, mean, k){
Added: pkg/RobLox/R/rowRoblox.R
===================================================================
--- pkg/RobLox/R/rowRoblox.R (rev 0)
+++ pkg/RobLox/R/rowRoblox.R 2008-02-22 11:55:48 UTC (rev 69)
@@ -0,0 +1,298 @@
+###############################################################################
+## computation of k-step construction in case x is a matrix
+###############################################################################
+.onestep.loc.matrix <- function(x, initial.est, A, b, sd){
+ u <- A*(x-initial.est)/sd^2
+ ind <- b/abs(u) <= 1
+ IC <- rowMeans(u*(ind*b/abs(u) + !ind), na.rm = TRUE)
+ return(initial.est + IC)
+}
+.kstep.loc.matrix <- function(x, initial.est, A, b, sd, k){
+ est <- initial.est
+ for(i in 1:k){
+ est <- .onestep.loc.matrix(x = x, initial.est = est, A = A, b = b, sd = sd)
+ }
+ return(est)
+}
+.onestep.sc.matrix <- function(x, initial.est, A, a, b, mean){
+ v <- A*(((x-mean)/initial.est)^2-1)/initial.est - a
+ ind <- b/abs(v) <= 1
+ IC <- rowMeans(v*(ind*b/abs(v) + !ind), na.rm = TRUE)
+ return(initial.est + IC)
+}
+.kstep.sc.matrix <- function(x, initial.est, A, a, b, mean, k){
+ est <- .onestep.sc.matrix(x = x, initial.est = initial.est, A = A, a = a, b = b, mean = mean)
+ if(k == 1){
+ return(est)
+ }else{
+ for(i in 2:k){
+ A <- est^2*A/initial.est^2
+ a <- est*a/initial.est
+ b <- est*b/initial.est
+ initial.est <- est
+ est <- .onestep.sc.matrix(x = x, initial.est = est, A = A, a = a, b = b, mean = mean)
+ }
+ return(est)
+ }
+}
+.onestep.locsc.matrix <- function(x, initial.est, A1, A2, a, b){
+ mean <- initial.est[,1]
+ sd <- initial.est[,2]
+ u <- A1*(x-mean)/sd^2
+ v <- A2*(((x-mean)/sd)^2-1)/sd - a
+ ind <- b/sqrt(u^2 + v^2) <= 1
+ IC1 <- rowMeans(u*(ind*b/sqrt(u^2 + v^2) + !ind), na.rm = TRUE)
+ IC2 <- rowMeans(v*(ind*b/sqrt(u^2 + v^2) + !ind), na.rm = TRUE)
+ IC <- cbind(IC1, IC2)
+ return(initial.est + IC)
+}
+.kstep.locsc.matrix <- function(x, initial.est, A1, A2, a, b, mean, k){
+ est <- .onestep.locsc.matrix(x = x, initial.est = initial.est, A1 = A1, A2 = A2, a = a, b = b)
+ if(k == 1){
+ return(est)
+ }else{
+ for(i in 2:k){
+ A1 <- est[,2]^2*A1/initial.est[,2]^2
+ A2 <- est[,2]^2*A2/initial.est[,2]^2
+ a <- est[,2]*a/initial.est[,2]
+ b <- est[,2]*b/initial.est[,2]
+ initial.est <- est
+ est <- .onestep.locsc.matrix(x = x, initial.est = est, A1 = A1, A2 = A2, a = a, b = b)
+ }
+ return(est)
+ }
+}
+
+
+###############################################################################
+## Evaluate roblox on rows of a matrix
+###############################################################################
+rowRoblox <- function(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1){
+ if(missing(x))
+ stop("'x' is missing with no default")
+ x <- as.matrix(x)
+ if(!is.matrix(x))
+ stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'")
+
+ if(missing(eps) && missing(eps.lower) && missing(eps.upper)){
+ eps.lower <- 0
+ eps.upper <- 0.5
+ }
+ if(missing(eps)){
+ if(!missing(eps.lower) && missing(eps.upper))
+ eps.upper <- 0.5
+ if(missing(eps.lower) && !missing(eps.upper))
+ eps.lower <- 0
+ if(length(eps.lower) != 1 || length(eps.upper) != 1)
+ stop("'eps.lower' and 'eps.upper' have to be of length 1")
+ if(!is.numeric(eps.lower) || !is.numeric(eps.upper) || eps.lower >= eps.upper)
+ stop("'eps.lower' < 'eps.upper' is not fulfilled")
+ if((eps.lower < 0) || (eps.upper > 0.5))
+ stop("'eps.lower' and 'eps.upper' have to be in [0, 0.5]")
+ }else{
+ if(length(eps) != 1)
+ stop("'eps' has to be of length 1")
+ 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(k < 1){
+ stop("'k' has to be some positive integer value")
+ }
+ if(length(k) != 1){
+ stop("'k' has to be of length 1")
+ }
+ k <- as.integer(k)
+
+ if(missing(mean) && missing(sd)){
+ if(missing(initial.est)){
+ mean <- apply(x, 1, median, na.rm = TRUE)
+ sd <- apply(x, 1, mad, na.rm = TRUE)
+ }else{
+ if(nrow(initial.est) != nrow(x) || ncol(initial.est) != 2)
+ stop("'initial.est' has wrong dimension")
+ mean <- initial.est[,1]
+ sd <- initial.est[,2]
+ }
+
+ if(!missing(eps)){
+ r <- sqrt(ncol(x))*eps
+ if(r > 10){
+ b <- sd*1.618128043
+ const <- 1.263094656
+ A2 <- b^2*(1+r^2)/(1+const)
+ A1 <- const*A2
+ a <- -0.6277527697*A2/sd
+ mse <- A1 + A2
+ }else{
+ A1 <- sd^2*.getA1.locsc(r)
+ A2 <- sd^2*.getA2.locsc(r)
+ a <- sd*.geta.locsc(r)
+ b <- sd*.getb.locsc(r)
+ mse <- A1 + A2
+ }
+ robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
+ A1 = A1, A2 = A2, a = a, b = b, k = k)
+ return(list(mean = robEst[,1], sd = robEst[,2]))
+ }else{
+ sqrtn <- sqrt(ncol(x))
+ rlo <- sqrtn*eps.lower
+ rup <- sqrtn*eps.upper
+ if(rlo > 10){
+ r <- (rlo + rup)/2
+ }else{
+ r <- uniroot(.getlsInterval, lower = rlo+1e-8, upper = rup,
+ tol = .Machine$double.eps^0.25, rlo = rlo, rup = rup)$root
+ }
+ if(r > 10){
+ b <- sd*1.618128043
+ const <- 1.263094656
+ A2 <- b^2*(1+r^2)/(1+const)
+ A1 <- const*A2
+ a <- -0.6277527697*A2/sd
+ mse <- A1 + A2
+ }else{
+ A1 <- sd^2*.getA1.locsc(r)
+ A2 <- sd^2*.getA2.locsc(r)
+ a <- sd*.geta.locsc(r)
+ b <- sd*.getb.locsc(r)
+ mse <- A1 + A2
+ }
+ if(rlo == 0){
+ ineff <- (A1 + A2 - b^2*r^2)/(1.5*sd^2)
+ }else{
+ if(rlo > 10){
+ ineff <- 1
+ }else{
+ A1lo <- sd^2*.getA1.locsc(rlo)
+ A2lo <- sd^2*.getA2.locsc(rlo)
+ ineff <- (A1 + A2 - b^2*(r^2 - rlo^2))/(A1lo + A2lo)
+ }
+ }
+ robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
+ A1 = A1, A2 = A2, a = a, b = b, k = k)
+ return(list(mean = robEst[,1], sd = robEst[,2],
+ "contamination interval" = round(c(eps.lower, eps.upper), 3),
+ "least favorable contamination" = round(r/sqrtn, 3),
+ "maximum MSE-inefficiency" = round(ineff[1], 3)))
+ }
+ }else{
+ if(missing(mean)){
+ if(missing(initial.est)){
+ mean <- apply(x, 1, median, na.rm = TRUE)
+ }else{
+ if(!is.numeric(sd) || (length(sd) != 1 && length(sd) != nrow(x)))
+ stop("'sd' has wrong dimension")
+ if(!is.numeric(initial.est) || length(initial.est) != nrow(x))
+ stop("'initial.est' has wrong dimension")
+ mean <- initial.est
+ }
+
+ if(!missing(eps)){
+ r <- sqrt(ncol(x))*eps
+ if(r > 10){
+ b <- sd*sqrt(pi/2)
+ A <- b^2*(1+r^2)
+ }else{
+ A <- sd^2*.getA.loc(r)
+ b <- sd*.getb.loc(r)
+ }
+ robEst <- .kstep.loc.matrix(x = x, initial.est = mean, A = A, b = b, sd = sd, k = k)
+ return(list(mean = robEst, sd = sd))
+ }else{
+ sqrtn <- sqrt(ncol(x))
+ rlo <- sqrtn*eps.lower
+ rup <- sqrtn*eps.upper
+ if(rlo > 10){
+ r <- (rlo+rup)/2
+ }else{
+ r <- uniroot(.getlInterval, lower = rlo+1e-8, upper = rup,
+ tol = .Machine$double.eps^0.25, rlo = rlo, rup = rup)$root
+ }
+ if(r > 10){
+ b <- sd*sqrt(pi/2)
+ A <- b^2*(1+r^2)
+ }else{
+ A <- sd^2*.getA.loc(r)
+ b <- sd*.getb.loc(r)
+ }
+ if(rlo == 0){
+ ineff <- (A - b^2*r^2)/sd^2
+ }else{
+ if(rlo > 10){
+ ineff <- 1
+ }else{
+ Alo <- sd^2*.getA.loc(rlo)
+ ineff <- (A - b^2*(r^2 - rlo^2))/Alo
+ }
+ }
+ robEst <- .kstep.loc.matrix(x = x, initial.est = mean, A = A, b = b, sd = sd, k = k)
+ return(list(mean = robEst, sd = sd,
+ "contamination interval" = round(c(eps.lower, eps.upper), 3),
+ "least favorable contamination" = round(r/sqrtn, 3),
+ "maximum MSE-inefficiency" = round(ineff[1], 3)))
+ }
+ }
+ if(missing(sd)){
+ if(missing(initial.est)){
+ sd <- apply(x, 1, mad, na.rm = TRUE)
+ }else{
+ if(!is.numeric(mean) || (length(mean) != 1 && length(mean) != nrow(x)))
+ stop("'mean' has wrong dimension")
+ if(!is.numeric(initial.est) || length(initial.est) != nrow(x))
+ stop("'initial.est' has wrong dimension")
+ sd <- initial.est
+ }
+
+ if(!missing(eps)){
+ r <- sqrt(ncol(x))*eps
+ if(r > 10){
+ b <- sd/(4*qnorm(0.75)*dnorm(qnorm(0.75)))
+ A <- b^2*(1+r^2)
+ a <- (qnorm(0.75)^2 - 1)/sd*A
+ }else{
+ A <- sd^2*.getA.sc(r)
+ a <- sd*.geta.sc(r)
+ b <- sd*.getb.sc(r)
+ }
+ robEst <- .kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ return(list(mean = mean, sd = robEst))
+ }else{
+ sqrtn <- sqrt(ncol(x))
+ rlo <- sqrtn*eps.lower
+ rup <- sqrtn*eps.upper
+ if(rlo > 10){
+ r <- (rlo+rup)/2
+ }else{
+ r <- uniroot(.getsInterval, lower = rlo+1e-8, upper = rup,
+ tol = .Machine$double.eps^0.25, rlo = rlo, rup = rup)$root
+ }
+ if(r > 10){
+ b <- sd/(4*qnorm(0.75)*dnorm(qnorm(0.75)))
+ A <- b^2*(1+r^2)
+ a <- (qnorm(0.75)^2 - 1)/sd*A
+ }else{
+ A <- sd^2*.getA.sc(r)
+ a <- sd*.geta.sc(r)
+ b <- sd*.getb.sc(r)
+ }
+ if(rlo == 0){
+ ineff <- (A - b^2*r^2)/(0.5*sd^2)
+ }else{
+ if(rlo > 10){
+ ineff <- 1
+ }else{
+ Alo <- sd^2*.getA.sc(rlo)
+ ineff <- (A - b^2*(r^2 - rlo^2))/Alo
+ }
+ }
+ robEst <- .kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ return(list(mean = mean, sd = robEst,
+ "contamination interval" = round(c(eps.lower, eps.upper), 3),
+ "least favorable contamination" = round(r/sqrtn, 3),
+ "maximum MSE-inefficiency" = round(ineff[1], 3)))
+ }
+ }
+ }
+}
Modified: pkg/RobLox/inst/tests/tests.R
===================================================================
--- pkg/RobLox/inst/tests/tests.R 2008-02-22 10:01:13 UTC (rev 68)
+++ pkg/RobLox/inst/tests/tests.R 2008-02-22 11:55:48 UTC (rev 69)
@@ -73,3 +73,146 @@
system.time(for(i in 1:100) roblox(x, k = 2))
system.time(for(i in 1:100) roblox(x, k = 5))
system.time(for(i in 1:100) roblox(x, returnIC = TRUE))
+
+
+## Samples
+X <- matrix(rnorm(200, mean = -2, sd = 3), nrow = 2)
+X1 <- rbind(rnorm(100, mean = -2, sd = 3), rnorm(100, mean = -1, sd = 4))
+
+## location: rowRoblox
+apply(X, 1, roblox, sd = 3)
+rowRoblox(X, sd = 3)
+apply(X, 1, roblox, eps = 0.06, sd = 3)
+rowRoblox(X, eps = 0.06, sd = 3)
+
+apply(X, 1, roblox, sd = 3, k = 3)
+rowRoblox(X, sd = c(3, 3), k = 3)
+apply(X, 1, roblox, eps = 0.06, sd = 3, k = 3)
+rowRoblox(X, eps = 0.06, sd = 3, k = 3)
+
+roblox(X1[1,], sd = 3)
+roblox(X1[2,], sd = 4)
+rowRoblox(X1, sd = c(3, 4))
+roblox(X1[1,], eps = 0.06, sd = 3)
+roblox(X1[2,], eps = 0.06, sd = 4)
+rowRoblox(X1, eps = 0.06, sd = c(3, 4))
+
+roblox(X1[1,], sd = 3, k = 4)
+roblox(X1[2,], sd = 4, k = 4)
+rowRoblox(X1, sd = c(3, 4), k = 4)
+roblox(X1[1,], eps = 0.06, sd = 3, k = 4)
+roblox(X1[2,], eps = 0.06, sd = 4, k = 4)
+rowRoblox(X1, eps = 0.06, sd = c(3, 4), k = 4)
+
+
+## scale: rowRoblox
+apply(X, 1, roblox, mean = -2)
+rowRoblox(X, mean = -2)
+apply(X, 1, roblox, eps = 0.049, mean = -2)
+rowRoblox(X, eps = 0.049, mean = -2)
+
+apply(X, 1, roblox, mean = -2, k = 3)
+rowRoblox(X, mean = c(-2, -2), k = 3)
+apply(X, 1, roblox, eps = 0.049, mean = -2, k = 3)
+rowRoblox(X, eps = 0.049, mean = c(-2, -2), k = 3)
+
+roblox(X1[1,], mean = -2)
+roblox(X1[2,], mean = -1)
+rowRoblox(X1, mean = c(-2, -1))
+roblox(X1[1,], eps = 0.049, mean = -2)
+roblox(X1[2,], eps = 0.049, mean = -1)
+rowRoblox(X1, eps = 0.049, mean = c(-2, -1))
+
+roblox(X1[1,], mean = -2, k = 4)
+roblox(X1[2,], mean = -1, k = 4)
+rowRoblox(X1, mean = c(-2, -1), k = 4)
+roblox(X1[1,], eps = 0.049, mean = -2, k = 4)
+roblox(X1[2,], eps = 0.049, mean = -1, k = 4)
+rowRoblox(X1, eps = 0.049, mean = c(-2, -1), k = 4)
+
+## location and scale: rowRoblox
+apply(X, 1, roblox)
+rowRoblox(X)
+apply(X, 1, roblox, eps = 0.057)
+rowRoblox(X, eps = 0.057)
+
+apply(X, 1, roblox, k = 3)
+rowRoblox(X, k = 3)
+apply(X, 1, roblox, eps = 0.057, k = 3)
+rowRoblox(X, eps = 0.057, k = 3)
+
+
+## Samples
+X <- t(X)
+X1 <- t(X1)
+
+## location: colRoblox
+apply(X, 2, roblox, sd = 3)
+colRoblox(X, sd = 3)
+apply(X, 2, roblox, eps = 0.06, sd = 3)
+colRoblox(X, eps = 0.06, sd = 3)
+
+apply(X, 2, roblox, sd = 3, k = 3)
+colRoblox(X, sd = c(3, 3), k = 3)
+apply(X, 2, roblox, eps = 0.06, sd = 3, k = 3)
+colRoblox(X, eps = 0.06, sd = 3, k = 3)
+
+roblox(X1[,1], sd = 3)
+roblox(X1[,2], sd = 4)
+colRoblox(X1, sd = c(3, 4))
+roblox(X1[,1], eps = 0.06, sd = 3)
+roblox(X1[,2], eps = 0.06, sd = 4)
+colRoblox(X1, eps = 0.06, sd = c(3, 4))
+
+roblox(X1[,1], sd = 3, k = 4)
+roblox(X1[,2], sd = 4, k = 4)
+colRoblox(X1, sd = c(3, 4), k = 4)
+roblox(X1[,1], eps = 0.06, sd = 3, k = 4)
+roblox(X1[,2], eps = 0.06, sd = 4, k = 4)
+colRoblox(X1, eps = 0.06, sd = c(3, 4), k = 4)
+
+
+## scale: colRoblox
+apply(X, 2, roblox, mean = -2)
+colRoblox(X, mean = -2)
+apply(X, 2, roblox, eps = 0.049, mean = -2)
+colRoblox(X, eps = 0.049, mean = -2)
+
+apply(X, 2, roblox, mean = -2, k = 3)
+colRoblox(X, mean = c(-2, -2), k = 3)
+apply(X, 2, roblox, eps = 0.049, mean = -2, k = 3)
+colRoblox(X, eps = 0.049, mean = c(-2, -2), k = 3)
+
+roblox(X1[,1], mean = -2)
+roblox(X1[,2], mean = -1)
+colRoblox(X1, mean = c(-2, -1))
+roblox(X1[,1], eps = 0.049, mean = -2)
+roblox(X1[,2], eps = 0.049, mean = -1)
+colRoblox(X1, eps = 0.049, mean = c(-2, -1))
+
+roblox(X1[,1], mean = -2, k = 4)
+roblox(X1[,2], mean = -1, k = 4)
+colRoblox(X1, mean = c(-2, -1), k = 4)
+roblox(X1[,1], eps = 0.049, mean = -2, k = 4)
+roblox(X1[,2], eps = 0.049, mean = -1, k = 4)
+colRoblox(X1, eps = 0.049, mean = c(-2, -1), k = 4)
+
+## location and scale: colRoblox
+apply(X, 2, roblox)
+colRoblox(X)
+apply(X, 2, roblox, eps = 0.057)
+colRoblox(X, eps = 0.057)
+
+apply(X, 2, roblox, k = 3)
+colRoblox(X, k = 3)
+apply(X, 2, roblox, eps = 0.057, k = 3)
+colRoblox(X, eps = 0.057, k = 3)
+
+
+## some timings
+X <- matrix(rnorm(1e5, mean = -1, sd = 3), ncol = 100)
+system.time(apply(X, 1, roblox, eps = 0.02))
+system.time(rowRoblox(X, eps = 0.02))
+
+system.time(apply(X, 1, roblox))
+system.time(rowRoblox(X))
Modified: pkg/RobLox/man/roblox.Rd
===================================================================
--- pkg/RobLox/man/roblox.Rd 2008-02-22 10:01:13 UTC (rev 68)
+++ pkg/RobLox/man/roblox.Rd 2008-02-22 11:55:48 UTC (rev 69)
@@ -18,9 +18,9 @@
\item{eps}{ positive real (0 < \code{eps} <= 0.5): amount of gross errors.
See details below. }
\item{eps.lower}{ positive real (0 <= \code{eps.lower} <= \code{eps.upper}):
- lower bound for the amount of gross errors. See details below }
+ lower bound for the amount of gross errors. See details below. }
\item{eps.upper}{ positive real (\code{eps.lower} <= \code{eps.upper} <= 0.5):
- upper bound for the amount of gross errors. See details below }
+ upper bound for the amount of gross errors. See details below. }
\item{initial.est}{ initial estimate for \code{mean} and/or \code{sd}. If missing
median and/or MAD are used. }
\item{k}{ positive integer. k-step is used to compute the optimally robust estimator.}
@@ -56,8 +56,8 @@
}
\value{
list of location and scale estimates
- \item{mean }{Description of 'comp1'}
- \item{sd }{Description of 'comp2'}
+ \item{mean }{ (estimated) mean}
+ \item{sd }{ (estimated) sd }
if 'returnIC' is 'TRUE' the list also contains
\item{optIC}{ object of class \code{"ContIC"}; optimally robust IC }
Added: pkg/RobLox/man/rowRoblox.Rd
===================================================================
--- pkg/RobLox/man/rowRoblox.Rd (rev 0)
+++ pkg/RobLox/man/rowRoblox.Rd 2008-02-22 11:55:48 UTC (rev 69)
@@ -0,0 +1,126 @@
+\name{rowRoblox and colRoblox}
+\alias{rowRoblox}
+\alias{colRoblox}
+\title{Optimally robust estimator for location and/or scale}
+\description{
+ The functions \code{rowRoblox} and \code{colRoblox} compute
+ the optimally robust estimator for normal location und/or scale and
+ (convex) contamination neighborhoods. The definition of
+ these estimators can be found in Rieder (1994) or Kohl (2005),
+ respectively.
+}
+\usage{
+rowRoblox(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1)
+colRoblox(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1)
+}
+\arguments{
+ \item{x}{ matrix \code{x} of data values }
+ \item{mean}{ specified mean. See details below. }
+ \item{sd}{ specified standard deviation. See details below. }
+ \item{eps}{ positive real (0 < \code{eps} <= 0.5): amount of gross errors.
+ See details below. }
+ \item{eps.lower}{ positive real (0 <= \code{eps.lower} <= \code{eps.upper}):
+ lower bound for the amount of gross errors. See details below. }
+ \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{initial.est}{ initial estimate for \code{mean} and/or \code{sd}. If missing
+ median and/or MAD are used. }
+ \item{k}{ positive integer. k-step is used to compute the optimally robust estimator.}
+}
+\details{
+ Computes the optimally robust estimator for location with scale specified,
+ scale with location specified, or both if neither is specified. The computation
+ uses a k-step construction with an appropriate initial estimate for location
+ or scale or location and scale, respectively. Valid candidates are e.g.
+ median and/or MAD (default) as well as Kolmogorov(-Smirnov) or von Mises minimum
+ distance estimators; cf. Rieder (1994) and Kohl (2005).
+
+ These functions are optimized for the situation where one has a matrix
+ and wants to compute the optimally robust estimator for every row,
+ respectively column of this matrix. In particular, the amount of cross
+ errors is assumed to be constant for all rows, respectively columns.
+
+ If the amount of gross errors (contamination) is known, it can be
+ specified by \code{eps}. The radius of the corresponding infinitesimal
+ contamination neighborhood is obtained by multiplying \code{eps}
+ by the square root of the sample size.
+
+ If the amount of gross errors (contamination) is unknown, try to find a
+ rough estimate for the amount of gross errors, such that it lies
+ between \code{eps.lower} and \code{eps.upper}.
+
+ In case \code{eps.lower} is specified and \code{eps.upper} is missing,
+ \code{eps.upper} is set to 0.5. In case \code{eps.upper} is specified and
+ \code{eps.lower} is missing, \code{eps.lower} is set to 0.
+
+ If neither \code{eps} nor \code{eps.lower} and/or \code{eps.upper} is
+ specified, \code{eps.lower} and \code{eps.upper} are set to 0 and 0.5,
+ respectively.
+
+ If \code{eps} is missing, the radius-minimax estimator in sense of
+ Rieder et al. (2001), respectively Section 2.2 of Kohl (2005) is returned.
+
+ In case of location, respectively scale one additionally has to specify
+ \code{sd}, respectively \code{mean} where \code{sd} and \code{mean} can
+ be a single number, i.e., identical for all rows, respectively columns,
+ or a vector, i.e., different for all rows, respectively columns.
+}
+\value{
+ list of location and scale estimates
+ \item{mean }{ (estimated) means }
+ \item{sd }{ (estimated) sds }
+
+ if 'eps' is missing the list also contains
+ \item{contamination interval}{ interval for the amount of gross errors }
+ \item{least favorable contamination}{ amount of gross errors used for the computations }
+ \item{maximum MSE-inefficiency}{ maximum (asymptotic) MSE-inefficiency }
+}
+\references{
+ Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
+ Bayreuth: Dissertation.
+
+ Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
+
+ Rieder, H., Kohl, M. and Ruckdeschel, P. (2008) The Costs of not Knowing
+ the Radius. Statistical Methods and Applications \emph{17}(1) 13-40.
+
+ Rieder, H., Kohl, M. and Ruckdeschel, P. (2001) The Costs of not Knowing
+ the Radius. Submitted. Appeared as discussion paper Nr. 81.
+ SFB 373 (Quantification and Simulation of Economic Processes),
+ Humboldt University, Berlin; also available under
+ \url{www.uni-bayreuth.de/departments/math/org/mathe7/RIEDER/pubs/RR.pdf}
+}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{\code{\link{roblox}}}
+\examples{
+ind <- rbinom(200, size=1, prob=0.05)
+X <- matrix(rnorm(200, mean=ind*3, sd=(1-ind) + ind*9), nrow = 2)
+rowRoblox(X)
+rowRoblox(X, k = 3)
+rowRoblox(X, eps = 0.05)
+rowRoblox(X, eps = 0.05, k = 3)
+
+X1 <- t(X)
+colRoblox(X1)
+colRoblox(X1, k = 3)
+colRoblox(X1, eps = 0.05)
+colRoblox(X1, eps = 0.05, k = 3)
+
+X2 <- rbind(rnorm(100, mean = -2, sd = 3), rnorm(100, mean = -1, sd = 4))
+rowRoblox(X2, sd = c(3, 4))
+rowRoblox(X2, eps = 0.03, sd = c(3, 4))
+rowRoblox(X2, sd = c(3, 4), k = 4)
+rowRoblox(X2, eps = 0.03, sd = c(3, 4), k = 4)
+
+X3 <- cbind(rnorm(100, mean = -2, sd = 3), rnorm(100, mean = 1, sd = 2))
+colRoblox(X3, mean = c(-2, 1))
+colRoblox(X3, eps = 0.02, mean = c(-2, 1))
+colRoblox(X3, mean = c(-2, 1), k = 4)
+colRoblox(X3, eps = 0.02, mean = c(-2, 1), k = 4)
+}
+\concept{normal location}
+\concept{normal scale}
+\concept{normal location and scale}
+\concept{influence curve}
+\keyword{robust}
More information about the Robast-commits
mailing list