[Robast-commits] r167 - in branches/robast-0.6/pkg: ROptEst/R ROptEst/inst/scripts ROptEst/man RobAStBase/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 27 21:59:48 CEST 2008
Author: ruckdeschel
Date: 2008-08-27 21:59:47 +0200 (Wed, 27 Aug 2008)
New Revision: 167
Modified:
branches/robast-0.6/pkg/ROptEst/R/getModifyIC.R
branches/robast-0.6/pkg/ROptEst/R/getRiskIC.R
branches/robast-0.6/pkg/ROptEst/R/optIC.R
branches/robast-0.6/pkg/ROptEst/inst/scripts/GumbelLocationModel.R
branches/robast-0.6/pkg/ROptEst/inst/scripts/UnderOverShootRisk.R
branches/robast-0.6/pkg/ROptEst/man/getBiasIC.Rd
branches/robast-0.6/pkg/ROptEst/man/getModifyIC.Rd
branches/robast-0.6/pkg/ROptEst/man/getRiskIC.Rd
branches/robast-0.6/pkg/RobAStBase/R/locMEstimator.R
Log:
checked scripts and fixed some minor things;
UnderOverShootRisk.R risk goes through now
@Matthias: still to be done: check why GammaModel script takes so long; and there is some graphic to be produced in distrDoc (section ParamFamParameter)
Modified: branches/robast-0.6/pkg/ROptEst/R/getModifyIC.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getModifyIC.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/R/getModifyIC.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -27,6 +27,12 @@
return(modIC)
})
+setMethod("getModifyIC", signature(L2FamIC = "L2LocationFamily",
+ neighbor = "UncondNeighborhood", risk = "fiUnOvShoot"),
+ getMethod("getModifyIC",signature(L2FamIC = "L2LocationFamily",
+ neighbor = "UncondNeighborhood", risk = "asGRisk"))
+ )
+
setMethod("getModifyIC", signature(L2FamIC = "L2ScaleFamily",
neighbor = "ContNeighborhood", risk = "asGRisk"),
function(L2FamIC, neighbor, risk){
Modified: branches/robast-0.6/pkg/ROptEst/R/getRiskIC.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getRiskIC.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/R/getRiskIC.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -19,6 +19,23 @@
return(list(asCov = list(distribution = .getDistr(L2Fam), value = Cov)))
})
+setMethod("getRiskIC", signature(IC = "TotalVarIC",
+ risk = "asCov",
+ neighbor = "missing",
+ L2Fam = "L2ParamFamily"),
+ function(IC, risk, L2Fam){
+ Cov <- IC at Risks[["asCov"]]
+ if (is.null(Cov)){
+ L2deriv <- L2Fam at L2derivDistr[[1]]
+ A <- IC at stand
+ c0 <- (IC at clipUp-IC@clipLo)/A
+ z <- IC at clipLo/A
+ neighbor <- TotalVarNeighborhood(1)
+ Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
+ biastype = biastype(IC), clip = c0, cent = z, stand = A)
+ }
+ return(list(asCov = list(distribution = .getDistr(L2Fam), value = Cov)))
+ })
###############################################################################
## asymptotic Bias for various types
@@ -27,10 +44,27 @@
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam,...){
if(missing(L2Fam))
- L2Fam <- eval(IC at CallL2Fam)
+ L2Fam <- force(eval(IC at CallL2Fam))
+ Bias <- IC at Risks$asBias$value
+
return(list(asBias = list(distribution = .getDistr(L2Fam),
- neighborhood = neighbor at type, value = IC at Risks$asBias$value)))
+ neighborhood = neighbor at type, value = Bias)))
})
+setMethod("getBiasIC", signature(IC = "TotalVarIC",
+ neighbor = "UncondNeighborhood"),
+ function(IC, neighbor, L2Fam,...){
+ if(missing(L2Fam))
+ L2Fam <- force(eval(IC at CallL2Fam))
+ Bias <- IC at Risks$asBias$value
+ if (is.null(Bias)){
+ Bias <- if(is(neighbor,"ContNeighborhood"))
+ max(IC at clipUp,-IC at clipLo) else IC at clipUp-IC@clipLo
+ }
+
+ return(list(asBias = list(distribution = .getDistr(L2Fam),
+ neighborhood = neighbor at type, value = Bias)))
+ })
+
Modified: branches/robast-0.6/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/optIC.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/R/optIC.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -72,22 +72,26 @@
tol = .Machine$double.eps^0.4, warn = TRUE){
L2derivDistr <- model at center@L2derivDistr[[1]]
if((length(model at center@L2derivDistr) == 1) & is(L2derivDistr, "UnivariateDistribution")){
- ow <- options("warn")
- options(warn = -1)
- res <- getInfRobIC(L2deriv = L2derivDistr,
+ if(identical(all.equal(model at neighbor@radius, 0), TRUE)){
+ return(optIC(model at center, risk = asCov()))
+ }else{
+ ow <- options("warn")
+ options(warn = -1)
+ res <- getInfRobIC(L2deriv = L2derivDistr,
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
- if(is(model at neighbor, "ContNeighborhood"))
- res$info <- c("optIC", "optIC", res$info, "Optimal IC for 'InfRobModel' with 'ContNeighborhood'!!!")
- else
- res$info <- c("optIC", res$info)
- res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
- neighbor = model at neighbor,
- risk = risk))
- return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
+ options(ow)
+ if(is(model at neighbor, "ContNeighborhood"))
+ res$info <- c("optIC", "optIC", res$info, "Optimal IC for 'InfRobModel' with 'ContNeighborhood'!!!")
+ else
+ res$info <- c("optIC", res$info)
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
+ neighbor = model at neighbor,
+ risk = risk))
+ return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
+ }
}else{
stop("restricted to 1-dimensional parameteric models")
}
Modified: branches/robast-0.6/pkg/ROptEst/inst/scripts/GumbelLocationModel.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/inst/scripts/GumbelLocationModel.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/inst/scripts/GumbelLocationModel.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -131,4 +131,4 @@
neighbor=ContNeighborhood(), risk=asMSE(), loRad=0.5, upRad=1)
(G0.est21 <- locMEstimator(G0.x, IC=G0.IC101))
-distrExOptions(ElowerTruncQuantile, 0) # default
+distrExOptions(ElowerTruncQuantile=0) # default
Modified: branches/robast-0.6/pkg/ROptEst/inst/scripts/UnderOverShootRisk.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/inst/scripts/UnderOverShootRisk.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/inst/scripts/UnderOverShootRisk.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -110,14 +110,14 @@
## 3. Kolmogorov(-Smirnov) minimum distance estimator
-(est0 <- MDEstimator(x=X, NormLocationFamily(), interval = c(-5, 5)))
+(est0 <- MDEstimator(x=X, NormLocationFamily()))
## 4. one-step estimation
-N0.Rob7 <- InfRobModel(center = NormLocationFamily(mean = est0$estimate),
+N0.Rob7 <- InfRobModel(center = NormLocationFamily(mean = estimate(est0)),
neighbor = ContNeighborhood(radius=0.5))
N0.IC9 <- optIC(model=N0.Rob7, risk=asUnOvShoot(width = 1.960))
-(est1 <- oneStepEstimator(X, IC = N0.IC9, start = est0$estimate))
-N0.Rob8 <- FixRobModel(center = NormLocationFamily(mean = est0$estimate),
+(est1 <- oneStepEstimator(X, IC = N0.IC9, start = estimate(est0)))
+N0.Rob8 <- FixRobModel(center = NormLocationFamily(mean = estimate(est0)),
neighbor = ContNeighborhood(radius=0.05))
N0.IC10 <- optIC(model=N0.Rob8, risk=fiUnOvShoot(width = 1.960/sqrt(n)), sampleSize = 1e2)
-(est2 <- oneStepEstimator(X, IC = N0.IC10, start = est0$estimate))
+(est2 <- oneStepEstimator(X, IC = N0.IC10, start = estimate(est0)))
Modified: branches/robast-0.6/pkg/ROptEst/man/getBiasIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getBiasIC.Rd 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/man/getBiasIC.Rd 2008-08-27 19:59:47 UTC (rev 167)
@@ -3,6 +3,7 @@
\alias{getBiasIC}
\alias{getBiasIC-methods}
\alias{getBiasIC,HampIC,UncondNeighborhood-method}
+\alias{getBiasIC,TotalVarIC,UncondNeighborhood-method}
\title{Generic function for the computation of the asymptotic bias for an IC}
\description{
@@ -26,6 +27,10 @@
\describe{
\item{IC = "HampIC", neighbor = "UncondNeighborhood"}{
reads off the as. bias from the risks-slot of the IC. }
+ \item{IC = "TotalVarIC", neighbor = "UncondNeighborhood"}{
+ reads off the as. bias from the risks-slot of the IC,
+ resp. if this is \code{NULL} from the corresponding
+ Lagrange Multipliers. }
}}
\references{
Huber, P.J. (1968) Robust Confidence Limits. Z. Wahrscheinlichkeitstheor.
Modified: branches/robast-0.6/pkg/ROptEst/man/getModifyIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getModifyIC.Rd 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/man/getModifyIC.Rd 2008-08-27 19:59:47 UTC (rev 167)
@@ -3,11 +3,12 @@
\alias{getModifyIC-methods}
\alias{getModifyIC,L2ParamFamily,Neighborhood,asRisk-method}
\alias{getModifyIC,L2LocationFamily,UncondNeighborhood,asGRisk-method}
+\alias{getModifyIC,L2LocationFamily,UncondNeighborhood,fiUnOvShoot-method}
\alias{getModifyIC,L2ScaleFamily,ContNeighborhood,asGRisk-method}
\alias{getModifyIC,L2ScaleFamily,TotalVarNeighborhood,asGRisk-method}
\alias{getModifyIC,L2LocationScaleFamily,ContNeighborhood,asGRisk-method}
+\title{Generic Function for the Computation of Functions for Slot modifyIC}
-\title{Generic Function for the Computation of Functions for Slot modifyIC}
\description{
This function is used by internal computations and is rarely called directly.
}
@@ -15,6 +16,7 @@
getModifyIC(L2FamIC, neighbor, risk)
\S4method{getModifyIC}{L2ParamFamily,Neighborhood,asRisk}(L2FamIC, neighbor, risk)
\S4method{getModifyIC}{L2LocationFamily,UncondNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2LocationFamily,UncondNeighborhood,fiUnOvShoot}(L2FamIC, neighbor, risk)
\S4method{getModifyIC}{L2ScaleFamily,ContNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
\S4method{getModifyIC}{L2ScaleFamily,TotalVarNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
\S4method{getModifyIC}{L2LocationScaleFamily,ContNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
Modified: branches/robast-0.6/pkg/ROptEst/man/getRiskIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getRiskIC.Rd 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/ROptEst/man/getRiskIC.Rd 2008-08-27 19:59:47 UTC (rev 167)
@@ -4,6 +4,7 @@
\alias{getRiskIC-methods}
\alias{getRiskIC,HampIC,asCov,missing,missing-method}
\alias{getRiskIC,HampIC,asCov,missing,L2ParamFamily-method}
+\alias{getRiskIC,TotalVarIC,asCov,missing,L2ParamFamily-method}
\title{Generic function for the computation of a risk for an IC}
\description{
@@ -15,6 +16,7 @@
\S4method{getRiskIC}{HampIC,asCov,missing,missing}(IC, risk)
\S4method{getRiskIC}{HampIC,asCov,missing,L2ParamFamily}(IC, risk, L2Fam)
+\S4method{getRiskIC}{TotalVarIC,asCov,missing,L2ParamFamily}(IC, risk, L2Fam)
}
\arguments{
@@ -35,6 +37,9 @@
\item{IC = "HampIC", risk = "asCov", neighbor = "missing", L2Fam = "L2ParamFamily"}{
asymptotic covariance of \code{IC} under \code{L2Fam} read off from corresp. \code{Risks} slot. }
+ \item{IC = "TotalVarIC", risk = "asCov", neighbor = "missing", L2Fam = "L2ParamFamily"}{
+ asymptotic covariance of \code{IC} read off from corresp. \code{Risks} slot,
+ resp. if this is \code{NULL} calculates it via \code{\link{getInfV}}.}
}}
\references{
Huber, P.J. (1968) Robust Confidence Limits. Z. Wahrscheinlichkeitstheor.
Modified: branches/robast-0.6/pkg/RobAStBase/R/locMEstimator.R
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/R/locMEstimator.R 2008-08-27 09:02:39 UTC (rev 166)
+++ branches/robast-0.6/pkg/RobAStBase/R/locMEstimator.R 2008-08-27 19:59:47 UTC (rev 167)
@@ -21,7 +21,14 @@
ncol = 2)
colnames(Infos) <- c("method", "message")
asVar <- getRiskIC(IC, risk = asCov(), L2Fam = L2Fam)$asCov$value
- asBias <- getRiskIC(IC, risk = asBias(), L2Fam = L2Fam)$asBias$value
+ asBias <- getRiskIC(IC, risk = asBias(),
+ neighbor = ContNeighborhood(1),
+ L2Fam = L2Fam)$asBias$value
+
+ names(res$root) <- nms <- locscalename(L2Fam)
+ asVar <- PosDefSymmMatrix(asVar)
+ dimnames(asVar) <- list(nms, nms)
+ names(asBias) <- nms
}else{
Infos <- matrix(c("locMEstimator", "Location M estimate"), ncol = 2)
colnames(Infos) <- c("method", "message")
More information about the Robast-commits
mailing list