[Robast-commits] r72 - in pkg/RobLox: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 26 10:11:00 CET 2008
Author: stamats
Date: 2008-02-26 10:11:00 +0100 (Tue, 26 Feb 2008)
New Revision: 72
Modified:
pkg/RobLox/DESCRIPTION
pkg/RobLox/NAMESPACE
pkg/RobLox/R/colRoblox.R
pkg/RobLox/R/roblox.R
pkg/RobLox/R/rowRoblox.R
pkg/RobLox/man/roblox.Rd
pkg/RobLox/man/rowRoblox.Rd
Log:
roblox now works (should work) with matrix or data.frame, too
new return value S3-class "ALEstimate" of roblox with corresponding print method
Modified: pkg/RobLox/DESCRIPTION
===================================================================
--- pkg/RobLox/DESCRIPTION 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/DESCRIPTION 2008-02-26 09:11:00 UTC (rev 72)
@@ -1,6 +1,6 @@
Package: RobLox
Version: 0.6.0
-Date: 2008-02-22
+Date: 2008-02-26
Title: Optimally robust influence curves for location and scale
Description: functions for the determination of optimally
robust influence curves in case of normal
Modified: pkg/RobLox/NAMESPACE
===================================================================
--- pkg/RobLox/NAMESPACE 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/NAMESPACE 2008-02-26 09:11:00 UTC (rev 72)
@@ -21,3 +21,4 @@
roblox,
rowRoblox,
colRoblox)
+S3method(print, ALEstimate)
Modified: pkg/RobLox/R/colRoblox.R
===================================================================
--- pkg/RobLox/R/colRoblox.R 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/R/colRoblox.R 2008-02-26 09:11:00 UTC (rev 72)
@@ -4,9 +4,13 @@
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.data.frame(x))
+ x <- data.matrix(x)
+ else
+ x <- as.matrix(x)
if(!is.matrix(x))
- stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'")
+ stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'
+ or 'data.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-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/R/roblox.R 2008-02-26 09:11:00 UTC (rev 72)
@@ -160,6 +160,18 @@
returnIC = FALSE){
if(missing(x))
stop("'x' is missing with no default")
+ if(!is.numeric(x)){
+ if(is.data.frame(x))
+ x <- data.matrix(x)
+ else
+ x <- as.matrix(x)
+ if(!is.matrix(x))
+ stop("'x' has to be a numeric vector resp. a matrix or data.frame
+ with one row resp. column/(numeric) variable")
+ if(ncol(x) > 1 & nrow(x) > 1)
+ stop("number of rows and columns/variables > 1. Please, do use 'rowRoblox'
+ resp. 'colRoblox'.")
+ }
if(missing(eps) && missing(eps.lower) && missing(eps.upper)){
eps.lower <- 0
eps.upper <- 0.5
@@ -219,15 +231,22 @@
mse <- A1 + A2
}
robEst <- .kstep.locsc(x = x, initial.est = c(mean, sd), A1 = A1, A2 = A2, a = a, b = b, k = k)
+ names(robEst) <- c("mean", "sd")
+ Info.matrix <- matrix(c("roblox",
+ paste("optimally robust estimate for contamination 'eps' =", round(eps, 3),
+ "and 'asMSE'")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormLocationScaleFamily(mean = mean, sd = sd),
res = list(A = diag(c(A1, A2)), a = a, b = b, d = NULL,
risk = list(asMSE = mse, asBias = b, asCov = mse - r^2*b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'")))
- return(list(optIC = IC1, mean = robEst[1], sd = robEst[2]))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- return(list(mean = robEst[1], sd = robEst[2]))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -264,6 +283,13 @@
}
}
robEst <- .kstep.locsc(x = x, initial.est = c(mean, sd), A1 = A1, A2 = A2, a = a, b = b, k = k)
+ names(robEst) <- c("mean", "sd")
+ Info.matrix <- matrix(c(rep("roblox", 3),
+ paste("radius-minimax estimate for contamination interval [",
+ round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
+ paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
+ paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormLocationScaleFamily(mean = mean, sd = sd),
@@ -271,20 +297,21 @@
risk = list(asMSE = mse, asBias = b, asCov = mse - r^2*b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'")))
Infos(IC1) <- matrix(c(rep("roblox", 3),
- paste("radius-minimax IC for contamination interval [",
- round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
- paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
- paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
- ncol = 2, dimnames = list(NULL, c("method", "message")))
- return(list(optIC = IC1, mean = robEst[1], sd = robEst[2]))
+ paste("radius-minimax IC for contamination interval [",
+ round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
+ paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
+ paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- 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, 3)))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}
}else{
if(missing(mean)){
+ if(sd <= 0)
+ stop("'sd' has to be positive")
if(missing(initial.est)){
mean <- median(x, na.rm = TRUE)
}else{
@@ -303,15 +330,22 @@
b <- sd*.getb.loc(r)
}
robEst <- .kstep.loc(x = x, initial.est = mean, A = A, b = b, sd = sd, k = k)
+ names(robEst) <- "mean"
+ Info.matrix <- matrix(c("roblox",
+ paste("optimally robust estimate for contamination 'eps' =", round(eps, 3),
+ "and 'asMSE'")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormLocationFamily(mean = mean, sd = sd),
res = list(A = as.matrix(A), a = 0, b = b, d = NULL,
risk = list(asMSE = A, asBias = b, asCov = b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'")))
- return(list(optIC = IC1, mean = robEst, sd = sd))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- return(list(mean = robEst, sd = sd))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -340,6 +374,13 @@
}
}
robEst <- .kstep.loc(x = x, initial.est = mean, A = A, b = b, sd = sd, k = k)
+ names(robEst) <- "mean"
+ Info.matrix <- matrix(c(rep("roblox", 3),
+ paste("radius-minimax estimate for contamination interval [",
+ round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
+ paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
+ paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormLocationFamily(mean = mean, sd = sd),
@@ -352,21 +393,25 @@
paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
- return(list(optIC = IC1, mean = robEst, sd = sd))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- 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, 3)))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}
}
if(missing(sd)){
if(missing(initial.est)){
sd <- mad(x, na.rm = TRUE)
+ if(sd == 0)
+ stop("'mad(x, na.rm = TRUE) == 0' => cannot compute a valid initial estimate,
+ please specify one via 'initial.est'")
}else{
if(!is.numeric(initial.est) || length(initial.est) != 1)
stop("'initial.est' needs to be a numeric vector of length 1 or missing")
sd <- initial.est
+ if(initial.est <= 0)
+ stop("'initial.est <= 0'; i.e., is no valid scale estimate")
}
if(!missing(eps)){
@@ -381,15 +426,22 @@
b <- sd*.getb.sc(r)
}
robEst <- .kstep.sc(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ names(robEst) <- "sd"
+ Info.matrix <- matrix(c("roblox",
+ paste("optimally robust estimate for contamination 'eps' =", round(eps, 3),
+ "and 'asMSE'")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormScaleFamily(mean = mean, sd = sd),
res = list(A = as.matrix(A), a = a, b = b, d = NULL,
risk = list(asMSE = A, asBias = b, asCov = b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'")))
- return(list(optIC = IC1, mean = mean, sd = robEst))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- return(list(mean = mean, sd = robEst))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -420,6 +472,13 @@
}
}
robEst <- .kstep.sc(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ names(robEst) <- "sd"
+ Info.matrix <- matrix(c(rep("roblox", 3),
+ paste("radius-minimax estimate for contamination interval [",
+ round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
+ paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
+ paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
+ ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
L2Fam = NormScaleFamily(mean = mean, sd = sd),
@@ -432,13 +491,18 @@
paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
- return(list(optIC = IC1, mean = mean, sd = robEst))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix, "optIC" = IC1),
+ class = c("ALEstimate", "Estimate")))
}else
- 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, 3)))
+ return(structure(list("estimate" = robEst, "steps" = k, "Infos" = Info.matrix),
+ class = c("ALEstimate", "Estimate")))
}
}
}
}
+print.ALEstimate <- function(x, digits = getOption("digits"), ...){
+ print(x$estimate)
+ if(!is.null(x$Infos)){
+ print(x$Infos)
+ }
+}
Modified: pkg/RobLox/R/rowRoblox.R
===================================================================
--- pkg/RobLox/R/rowRoblox.R 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/R/rowRoblox.R 2008-02-26 09:11:00 UTC (rev 72)
@@ -70,9 +70,13 @@
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.data.frame(x))
+ x <- data.matrix(x)
+ else
+ x <- as.matrix(x)
if(!is.matrix(x))
- stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'")
+ stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'
+ or 'data.matrix'")
if(missing(eps) && missing(eps.lower) && missing(eps.upper)){
eps.lower <- 0
@@ -134,6 +138,7 @@
}
robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
A1 = A1, A2 = A2, a = a, b = b, k = k)
+ colnames(robEst) <- c("mean", "sd")
return(list(mean = robEst[,1], sd = robEst[,2]))
}else{
sqrtn <- sqrt(ncol(x))
Modified: pkg/RobLox/man/roblox.Rd
===================================================================
--- pkg/RobLox/man/roblox.Rd 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/man/roblox.Rd 2008-02-26 09:11:00 UTC (rev 72)
@@ -12,9 +12,10 @@
roblox(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1, returnIC = FALSE)
}
\arguments{
- \item{x}{ vector \code{x} of data values }
- \item{mean}{ specified mean.}
- \item{sd}{ specified standard deviation.}
+ \item{x}{ vector \code{x} of data values, may also be a matrix or data.frame
+ with one row, respectively one column/(numeric) variable. }
+ \item{mean}{ specified mean. }
+ \item{sd}{ specified standard deviation which has to be positive. }
\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}):
@@ -23,7 +24,7 @@
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.}
+ \item{k}{ positive integer. k-step is used to compute the optimally robust estimator. }
\item{returnIC}{ logical: should IC be returned. See details below. }
}
\details{
@@ -55,17 +56,14 @@
Rieder et al. (2001), respectively Section 2.2 of Kohl (2005) is returned.
}
\value{
- list of location and scale estimates
- \item{mean }{ (estimated) mean}
- \item{sd }{ (estimated) sd }
+ An object of S3-class \code{"ALEstimate"} which inherits from
+ class \code{"Estimate"}, a list with components
+ \item{estimate }{ location and/or scale estimate }
+ \item{steps }{ number of k-steps used to compute the estimate }
+ \item{Infos }{ additional information about the estimate }
- if 'returnIC' is 'TRUE' the list also contains
+ if \code{returnIC} is \code{TRUE} the list also contains
\item{optIC}{ object of class \code{"ContIC"}; optimally robust IC }
-
- if 'returnIC' is 'FALSE' and '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}.
Modified: pkg/RobLox/man/rowRoblox.Rd
===================================================================
--- pkg/RobLox/man/rowRoblox.Rd 2008-02-26 09:08:18 UTC (rev 71)
+++ pkg/RobLox/man/rowRoblox.Rd 2008-02-26 09:11:00 UTC (rev 72)
@@ -14,9 +14,10 @@
colRoblox(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1)
}
\arguments{
- \item{x}{ matrix \code{x} of data values }
+ \item{x}{ matrix or data.frame of (numeric) data values. }
\item{mean}{ specified mean. See details below. }
- \item{sd}{ specified standard deviation. See details below. }
+ \item{sd}{ specified standard deviation which has to be positive.
+ See also 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}):
@@ -70,7 +71,7 @@
\item{mean }{ (estimated) means }
\item{sd }{ (estimated) sds }
- if 'eps' is missing the list also contains
+ if \code{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 }
More information about the Robast-commits
mailing list