[Robast-commits] r416 - in branches/robast-0.8/pkg/ROptEst: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 3 00:39:15 CEST 2010
Author: ruckdeschel
Date: 2010-09-03 00:39:14 +0200 (Fri, 03 Sep 2010)
New Revision: 416
Added:
branches/robast-0.8/pkg/ROptEst/R/getAsGRiskfct.R
branches/robast-0.8/pkg/ROptEst/R/getReq.R
branches/robast-0.8/pkg/ROptEst/man/getAsGRiskFct-methods.Rd
branches/robast-0.8/pkg/ROptEst/man/getReq.Rd
Modified:
branches/robast-0.8/pkg/ROptEst/NAMESPACE
branches/robast-0.8/pkg/ROptEst/R/AllClass.R
branches/robast-0.8/pkg/ROptEst/R/AllGeneric.R
branches/robast-0.8/pkg/ROptEst/man/internals.Rd
Log:
ROptEst:
+ new method get.asGRisk.fct to obtain a function in r,s,b (s=var^.5) to compute respective as. G-Risk
+ new function getReq for two ICs IC1 and IC2 to compute a radius interval where IC1 is better than IC2 acc. to G-Risk
Modified: branches/robast-0.8/pkg/ROptEst/NAMESPACE
===================================================================
--- branches/robast-0.8/pkg/ROptEst/NAMESPACE 2010-09-02 20:58:23 UTC (rev 415)
+++ branches/robast-0.8/pkg/ROptEst/NAMESPACE 2010-09-02 22:39:14 UTC (rev 416)
@@ -26,6 +26,6 @@
"getL1normL2deriv",
"getModifyIC",
"cniperCont", "cniperPoint", "cniperPointPlot")
-exportMethods("updateNorm", "scaleUpdateIC", "eff")
-export("getL2normL2deriv","asAnscombe", "asL1", "asL4")
+exportMethods("updateNorm", "scaleUpdateIC", "eff", "get.asGRisk.fct")
+export("getL2normL2deriv","asAnscombe", "asL1", "asL4", "getReq")
export("roptest","getLagrangeMultByOptim","getLagrangeMultByIter")
Modified: branches/robast-0.8/pkg/ROptEst/R/AllClass.R
===================================================================
--- branches/robast-0.8/pkg/ROptEst/R/AllClass.R 2010-09-02 20:58:23 UTC (rev 415)
+++ branches/robast-0.8/pkg/ROptEst/R/AllClass.R 2010-09-02 22:39:14 UTC (rev 416)
@@ -22,7 +22,7 @@
## asymptotic L4 error
setClass("asL4", contains = "asGRisk",
- prototype = prototype(type = "asymptotic mean power4 error"))
+ prototype = prototype(type = "asymptotic mean power 4 error"))
## asymptotic L1 error
setClass("asL1", contains = "asGRisk",
prototype = prototype(type = "asymptotic mean absolute error"))
Modified: branches/robast-0.8/pkg/ROptEst/R/AllGeneric.R
===================================================================
--- branches/robast-0.8/pkg/ROptEst/R/AllGeneric.R 2010-09-02 20:58:23 UTC (rev 415)
+++ branches/robast-0.8/pkg/ROptEst/R/AllGeneric.R 2010-09-02 22:39:14 UTC (rev 416)
@@ -89,3 +89,6 @@
if(!isGeneric("eff")){
setGeneric("eff", function(object) standardGeneric("eff"))
}
+if(!isGeneric("get.asGRisk.fct")){
+ setGeneric("get.asGRisk.fct", function(Risk) standardGeneric("get.asGRisk.fct"))
+}
Added: branches/robast-0.8/pkg/ROptEst/R/getAsGRiskfct.R
===================================================================
--- branches/robast-0.8/pkg/ROptEst/R/getAsGRiskfct.R (rev 0)
+++ branches/robast-0.8/pkg/ROptEst/R/getAsGRiskfct.R 2010-09-02 22:39:14 UTC (rev 416)
@@ -0,0 +1,14 @@
+
+setMethod("get.asGRisk.fct", signature(Risk = "asL1"),
+ function(Risk){return( function(r,s,b){
+ rb <- r*b; w <- rb/s;
+ rb*(2*pnorm(w)-1)+2*s*dnorm(w)})})
+
+setMethod("get.asGRisk.fct", signature(Risk = "asMSE"),
+ function(Risk){ return(function(r,s,b){
+ rb <- r*b; rb^2+s^2})})
+
+setMethod("get.asGRisk.fct", signature(Risk = "asL4"),
+ function(Risk){ return(function(r,s,b){
+ rb <- r*b; rb^4+6*s^2*rb^2+3*s^4})})
+
Added: branches/robast-0.8/pkg/ROptEst/R/getReq.R
===================================================================
--- branches/robast-0.8/pkg/ROptEst/R/getReq.R (rev 0)
+++ branches/robast-0.8/pkg/ROptEst/R/getReq.R 2010-09-02 22:39:14 UTC (rev 416)
@@ -0,0 +1,35 @@
+.getSB <- function(IC,neighbor)
+ list(s = getRiskIC(IC,risk=trAsCov())$trAsCov$value^.5,
+ b = getRiskIC(IC,risk=asBias(),neighbor=neighbor)$asBias$value)
+
+getReq <- function(Risk,neighbor,IC1,IC2,n=1,upper=15){
+ if(!is(IC1,"IC")||!is(IC2,"IC"))
+ stop("Arguments IC1, IC2 must be of class 'IC'.")
+ if(!identical(IC1 at CallL2Fam,IC2 at CallL2Fam))
+ stop("Arguments IC1, IC2 must be of defined for the same model.")
+ sb1 <- .getSB(IC1,neighbor)
+ sb2 <- .getSB(IC2,neighbor)
+ if(abs(sb1$s-sb2$s)+ abs(sb1$b-sb2$b)<1e-6){
+ cat(gettext("IC1 is just as good as IC2.\n"))
+ return(c(0,Inf))
+ }
+ if((sb1$s<=sb2$s && sb1$b<sb2$b)||(sb1$s<=sb2$s && sb1$b<=sb2$b)){
+ cat(gettext("IC1 is strictly better than IC2.\n"))
+ return(c(0,Inf))}
+ if((sb2$s<=sb1$s && sb2$b<sb1$b)||(sb2$s<sb1$s && sb2$b<=sb1$b)){
+ cat(gettext("IC2 is strictly better than IC1.\n"))
+ return(NA)}
+ dRisk <- function(r){
+ get.asGRisk.fct(Risk)(r,s=sb1$s,b=sb1$b)-
+ get.asGRisk.fct(Risk)(r,s=sb2$s,b=sb2$b)
+ }
+ r0 <- uniroot(dRisk,lower=0, upper=upper)$root/n^.5
+ if(sb1$s<=sb2$s)
+ return(c(0,r0))
+ else
+ return(c(r0,Inf))
+ }
+
+
+
+
\ No newline at end of file
Added: branches/robast-0.8/pkg/ROptEst/man/getAsGRiskFct-methods.Rd
===================================================================
--- branches/robast-0.8/pkg/ROptEst/man/getAsGRiskFct-methods.Rd (rev 0)
+++ branches/robast-0.8/pkg/ROptEst/man/getAsGRiskFct-methods.Rd 2010-09-02 22:39:14 UTC (rev 416)
@@ -0,0 +1,41 @@
+\name{get.asGRisk.fct-methods}
+\docType{methods}
+\alias{get.asGRisk.fct-methods}
+\alias{get.asGRisk.fct}
+\alias{get.asGRisk.fct,asL1-method}
+\alias{get.asGRisk.fct,asL4-method}
+\alias{get.asGRisk.fct,asMSE-method}
+\title{Methods for Function get.asGRisk.fct in Package `ROptEst' }
+
+\description{get.asGRisk.fct-methods to produce a function in r,s,b for computing
+ a particular asGRisk}
+
+\usage{get.asGRisk.fct(Risk)
+\S4method{get.asGRisk.fct}{asMSE}(Risk)
+\S4method{get.asGRisk.fct}{asL1}(Risk)
+\S4method{get.asGRisk.fct}{asL4}(Risk)
+}
+
+\arguments{
+ \item{Risk}{a risk of class \code{"asGRisk"}}
+}
+\section{Methods}{\describe{
+\item{get.asGRisk.fct}{\code{signature(Risk = "asMSE")}: method for asymptotic mean squared error.}
+\item{get.asGRisk.fct}{\code{signature(Risk = "asL1")}: method for asymptotic mean absolute error.}
+\item{get.asGRisk.fct}{\code{signature(Risk = "asL4")}: method for asymptotic mean power 4 error.}
+}}
+\value{
+\item{get.asGRisk.fct}{a function with arguments \code{r} (radius), \code{s}
+(square root of (trace of) variance), \code{b} bias to compute the respective risk of an IC
+with this bias and variance at the respective radius.
+}
+}
+
+\details{\code{get.asGRisk.fct} is used internally in functions \code{\link{getAsRisk}}
+and \code{\link{getReq}}.}
+\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\examples{}
+\concept{asymptotic risk}
+\concept{risk}
+\keyword{classes}
+
Added: branches/robast-0.8/pkg/ROptEst/man/getReq.Rd
===================================================================
--- branches/robast-0.8/pkg/ROptEst/man/getReq.Rd (rev 0)
+++ branches/robast-0.8/pkg/ROptEst/man/getReq.Rd 2010-09-02 22:39:14 UTC (rev 416)
@@ -0,0 +1,48 @@
+\name{getReq}
+\alias{getReq}
+
+\title{getReq -- computation of the radius interval where IC1 is better than IC2}
+\description{
+ (tries to) compute a radius interval where IC1 is better than IC2
+}
+\usage{getReq(Risk,neighbor,IC1,IC2,n=1,upper=15)}
+\arguments{
+ \item{Risk}{an object of class \code{"asGRisk"} -- the risk at which IC1 is better than IC2.}
+ \item{neighbor}{ object of class \code{"Neighborhood"}; the neighborhood at which to compute the bias. }
+ \item{IC1}{some IC of class \code{"IC"}}
+ \item{IC2}{some IC of class \code{"IC"}}
+ \item{n}{the sample size; by default set to 1; then the radius interval refers to starting radii
+ in the shrinking neighborhood setting of Rieder[94]. Otherwise the radius interval is scaled
+ down accordingly.}
+ \item{upper}{the upper bound of the radius interval in which to search}
+}
+%\details{}
+\value{The radius interval (given by its endpoints) where \code{IC1} is better than \code{IC2}
+according to the risk. In case \code{IC2} is better than \code{IC1} as to both variance and bias,
+the return value is \code{NA}.}
+\references{
+ Hampel et al. (1986) \emph{Robust Statistics}.
+ The Approach Based on Influence Functions. New York: Wiley.
+
+ Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
+}
+\author{Peter Ruckdeschel \email{peter.ruckdeschel at fraunhofer.itwm.de}}
+%\note{}
+\examples{
+N0 <- NormLocationFamily(mean=2, sd=3)
+## L_2 family + infinitesimal neighborhood
+neighbor <- ContNeighborhood(radius = 0.5)
+N0.Rob1 <- InfRobModel(center = N0, neighbor = neighbor)
+## OBRE solution (ARE 95%)
+N0.ICA <- optIC(model = N0.Rob1, risk = asAnscombe(.95))
+## MSE solution
+N0.ICM <- optIC(model=N0.Rob1, risk=asMSE())
+
+getReq(asMSE(),neighbor,N0.ICA,N0.ICM,n=1)
+getReq(asMSE(),neighbor,N0.ICA,N0.ICM,n=30)
+getReq(asL1(),neighbor,N0.ICA,N0.ICM,n=30)
+getReq(asL4(),neighbor,N0.ICA,N0.ICM,n=30)
+}
+\concept{Hampel risk}
+\concept{risk}
+\keyword{robust}
Modified: branches/robast-0.8/pkg/ROptEst/man/internals.Rd
===================================================================
--- branches/robast-0.8/pkg/ROptEst/man/internals.Rd 2010-09-02 20:58:23 UTC (rev 415)
+++ branches/robast-0.8/pkg/ROptEst/man/internals.Rd 2010-09-02 22:39:14 UTC (rev 416)
@@ -7,6 +7,7 @@
\alias{.checkPIC}
\alias{.LowerCaseMultivariate}
\alias{.LowerCaseMultivariateTV}
+\alias{.getSB}
\title{Internal / Helper functions of package ROptEst}
@@ -52,6 +53,8 @@
normtype, Distr, Finfo, trafo,
A.start, maxiter, tol,
verbose = NULL)
+
+.getSB(IC,neighbor)
}
\arguments{
@@ -89,6 +92,7 @@
\item{iter}{the number of iterations computed so far; used for specifying
a different value of the clipping component of the weight in
total variation case in the very first iteration.}
+ \item{IC}{some IC of class \code{"IC"}}
\item{\dots}{further arguments to be passed on \code{E()}.}
}
@@ -111,6 +115,8 @@
\code{.LowerCaseMultivariatefunctionTV} determines the Lagrange multipliers for
the multivariate lower case solution for total variation in dimension \eqn{p=1}
and \eqn{k>1} by solving a corresponding dual problem (Rieder[94],p.205 eq.(58)).
+\code{.getSB} computes the bias and (the square root of the trace of) the variance
+ of the IC.
}
@@ -137,6 +143,8 @@
\code{b} the minimax bias,
\code{w} the corresponding weight (of class \code{BdStWeight}),
\code{a} the corresponding infimum of the [p]IC.}
+\item{.getSB}{a list with elements \code{s}, (the square root of the trace of)
+the variance and \code{b}, the bias.}
}
\references{
More information about the Robast-commits
mailing list