[Robast-commits] r354 - in branches/robast-0.7/pkg: ROptEst ROptEst/R ROptEst/chm ROptEst/inst/scripts ROptEst/man RobAStBase RobAStBase/R RobAStBase/chm RobAStBase/man RobLox/chm
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 27 17:19:30 CEST 2009
Author: ruckdeschel
Date: 2009-08-27 17:19:30 +0200 (Thu, 27 Aug 2009)
New Revision: 354
Modified:
branches/robast-0.7/pkg/ROptEst/NAMESPACE
branches/robast-0.7/pkg/ROptEst/R/AllGeneric.R
branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R
branches/robast-0.7/pkg/ROptEst/R/optIC.R
branches/robast-0.7/pkg/ROptEst/chm/00Index.html
branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
branches/robast-0.7/pkg/ROptEst/chm/ROptEst.toc
branches/robast-0.7/pkg/ROptEst/chm/getModifyIC.html
branches/robast-0.7/pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
branches/robast-0.7/pkg/ROptEst/man/getModifyIC.Rd
branches/robast-0.7/pkg/RobAStBase/NAMESPACE
branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R
branches/robast-0.7/pkg/RobAStBase/R/Neighborhood.R
branches/robast-0.7/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-0.7/pkg/RobAStBase/chm/00Index.html
branches/robast-0.7/pkg/RobAStBase/chm/Neighborhood-class.html
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.toc
branches/robast-0.7/pkg/RobAStBase/man/Neighborhood-class.Rd
branches/robast-0.7/pkg/RobLox/chm/RobLox.chm
Log:
several changes to enable treatment of kStepEstimator with nuisance parameters...
---------------------------------------------------------------------
RobAStBase
---------------------------------------------------------------------
+new generic
radius<- for Neighborhood
+ kStepEstimator
- deletion of dim attribute (which enters after rowMean(....)
- naming of coordinates of [untransformed.]estimate and
[untransformed.]asvar is done consistently to slot param
- in case no variance is computed in optIC asvar is determined
by E() in pxp dimension (= !var.to.be.c)
computations in k-Space are more problematic than thought
if matrix D has not got full rank or nuisance parameters are present:
* k-dimensional untransformed.estimate
this was clear; no problems as to this;
works for both options withUpdateInKer TRUE or FALSE
* k-dimensional IC
D^- %*% pIC is not an IC in case ker D is not trivial.
two options:
-> withUpdateInKer FALSE: be content
with a solution in Psi^(D^-D) ...
IC.tot = IC.tot1 = D^- %*% pIC
-> withUpdateInKer TRUE: complete IC.tot1
by addition of IC.tot2 = projker %*% IC2
for projker = I - D^-D and IC2 is either
a given IC IC.UpdateInKer or a default bounded IC gotten by getBoundedIC.
* kxk dimensinoal var
this is most problematic in case ker D is non-trivial:
- if argument start is of class ALEstimate and has a non-NULL pIC-slot
IC0, this one is taken for computation of untransformed.asvar, i.e.
IC.tot.0 = projker %*% IC0 + D^- %*% pIC
and untransformed.asvar = E(IC.tot.0 %*% IC.tot.0' )
otherwise NULL is returned in this case
- if argument start is of class Estimate and has a non-NULL asvar-slot
the one is taken later
- variances u.var and var0 are calculated in internal function
update only on demand, i.e. when with.u.var is TRUE
(which is true only in the last iteration step)
if (! var.to.be.c), ie. if asvar information is missing in
the optimized IC, we calculate it as
var0 <- matrix(E(L2Fam, IC.c %*% t(IC.c)),p,p)
---------------------------------------------------------------------
ROptEst
---------------------------------------------------------------------
+new generic
scaleUpdateIC for scale-Update in location/scale/locscale models
-> to avoid similar code for the many variants
ScaleModel, LocationScaleModel, LocationUnknownScaleModel,
ScaleUnknownLocationModel; in the latter two also
totalvariation nbds are allowed
getModifyIC has been changed so that also nuisance parameter models
can be covered.
script NormalLocationScaleModel.R now has an example with nuisance parameters
Modified: branches/robast-0.7/pkg/ROptEst/NAMESPACE
===================================================================
--- branches/robast-0.7/pkg/ROptEst/NAMESPACE 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/NAMESPACE 2009-08-27 15:19:30 UTC (rev 354)
@@ -25,6 +25,6 @@
"getL1normL2deriv",
"getModifyIC",
"cniperCont", "cniperPoint", "cniperPointPlot")
-exportMethods("updateNorm")
+exportMethods("updateNorm", "scaleUpdateIC")
export("getL2normL2deriv")
export("roptest","getLagrangeMultByOptim","getLagrangeMultByIter")
Modified: branches/robast-0.7/pkg/ROptEst/R/AllGeneric.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/AllGeneric.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/R/AllGeneric.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -74,6 +74,9 @@
if(!isGeneric("getModifyIC")){
setGeneric("getModifyIC", function(L2FamIC, neighbor, risk, ...) standardGeneric("getModifyIC"))
}
+if(!isGeneric("scaleUpdateIC")){
+ setGeneric("scaleUpdateIC", function(neighbor, ...) standardGeneric("scaleUpdateIC"))
+}
if(!isGeneric("cniperCont")){
setGeneric("cniperCont", function(IC1, IC2, L2Fam, neighbor, risk, ...) standardGeneric("cniperCont"))
}
Modified: branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -34,66 +34,68 @@
neighbor = "UncondNeighborhood", risk = "asGRisk"))
)
-setMethod("getModifyIC", signature(L2FamIC = "L2ScaleFamily",
- neighbor = "ContNeighborhood", risk = "asGRisk"),
- function(L2FamIC, neighbor, risk, ...){
- modIC <- function(L2Fam, IC){
- ICL2Fam <- eval(CallL2Fam(IC))
- if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
- sdneu <- main(L2Fam)
- sdalt <- main(ICL2Fam)
- r <- neighborRadius(IC)
- w <- weight(IC)
- clip(w) <- sdneu*clip(w)/sdalt
- cent(w) <- sdalt*cent(w)/sdneu
- stand(w) <- sdneu^2*stand(w)/sdalt^2
- weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
- biastype = biastype(IC),
- normW = normtype(IC))
- A <- sdneu^2*stand(IC)/sdalt^2
- b <- sdneu*clip(IC)/sdalt
- res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
- info = Infos(IC), w = w,
- normtype = normtype(IC), biastype = biastype(IC),
- modifyIC = modifyIC(IC))
- IC <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = L2Fam, res = res)
- addInfo(IC) <- c("modifyIC", "The IC has been modified")
- addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
- return(IC)
- }else{
- makeIC(IC, L2Fam)
- }
- }
- return(modIC)
- })
+setMethod("scaleUpdateIC", signature(neighbor="UncondNeighborhood"),
+ function(neighbor, sdneu, sdalt, IC){
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ risk0 <- Risks(IC)
+ risk <- NULL
+ risk$asMSE <- if(is.numeric(risk0$asMSE))
+ risk0$asMSE * sdneu^2 / sdalt^2 else NULL
+ risk$asCov <- if(is.numeric(risk0$asCov))
+ risk0$asCov * sdneu^2 / sdalt^2 else NULL
+ if(is.numeric(risk0$asCov$value))
+ risk$asCov$value <- risk0$asCov$value * sdneu^2 / sdalt^2
+ risk$asBias <- if(is.numeric(risk0$asBias))
+ risk0$asBias * sdneu / sdalt else NULL
+ return(list(A = A, d = NULL,
+ info = Infos(IC), w = w, risk = risk,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC)))
+})
+
+setMethod("scaleUpdateIC", signature(neighbor="ContNeighborhood"),
+ function(neighbor, sdneu, sdalt, IC){
+ r <- neighborRadius(IC)
+ fct <- getMethod("scaleUpdateIC",signature(neighbor="UncondNeighborhood"))
+ res <- fct(neighbor, sdneu, sdalt, IC); w <- res$w; A <- res$A
+ b <- sdneu*clip(IC)/sdalt
+ a <- sdneu*cent(IC)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ weight(w) <- getweight(w, neighbor, biastype = biastype(IC),
+ normW = normtype(IC))
+ return(c(res,list(a = a, b = b, w = w)))
+})
+
+setMethod("scaleUpdateIC", signature(neighbor="TotalVarNeighborhood"),
+ function(neighbor, sdneu, sdalt, IC){
+ r <- neighborRadius(IC)
+ fct <- getMethod("scaleUpdateIC",signature(neighbor="UncondNeighborhood"))
+ res <- fct(neighbor, sdneu, sdalt, IC); w <- res$w; A <- res$A
+ blo <- sdneu*clipLo(IC)/sdalt
+ b <- sdneu*clipUp(IC)/sdalt - blo
+ weight(w) <- getweight(w, neighbor, biastype = biastype(IC),
+ normW = normtype(IC))
+ return(c(res,list(a = blo, b = b, w = w)))
+})
+
setMethod("getModifyIC", signature(L2FamIC = "L2ScaleFamily",
- neighbor = "TotalVarNeighborhood", risk = "asGRisk"),
+ neighbor = "UncondNeighborhood", risk = "asGRisk"),
function(L2FamIC, neighbor, risk, ...){
modIC <- function(L2Fam, IC){
ICL2Fam <- eval(CallL2Fam(IC))
if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
- sdneu <- main(L2Fam)
- sdalt <- main(ICL2Fam)
- r <- neighborRadius(IC)
- w <- weight(IC)
- clip(w) <- sdneu*clip(w)/sdalt
- stand(w) <- sdneu^2*stand(w)/sdalt^2
- weight(w) <- getweight(w, neighbor = TotalVarNeighborhood(radius = r),
- biastype = biastype(IC),
- normW = normtype(IC))
- A <- sdneu^2*stand(IC)/sdalt^2
- blo <- sdneu*clipLo(IC)/sdalt
- b <- sdneu*clipUp(IC)/sdalt - blo
- res <- list(A = A, a = blo, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
- info = Infos(IC), w = w,
- normtype = normtype(IC), biastype = biastype(IC),
- modifyIC = modifyIC(IC))
- IC <- generateIC(neighbor = TotalVarNeighborhood(radius = r),
- L2Fam = L2Fam, res = res)
+ res <- scaleUpdateIC(sdneu = main(L2Fam),
+ sdalt = main(ICL2Fam),
+ IC = IC, neighbor = neighbor)
+ IC <- generateIC(neighbor = neighbor, L2Fam = L2Fam, res = res)
addInfo(IC) <- c("modifyIC", "The IC has been modified")
addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
return(IC)
@@ -104,37 +106,27 @@
return(modIC)
})
-setMethod("getModifyIC", signature(L2FamIC = "L2LocationScaleFamily",
- neighbor = "ContNeighborhood", risk = "asGRisk"),
+setMethod("getModifyIC", signature(L2FamIC = "L2LocationScaleFamily",
+ neighbor = "UncondNeighborhood", risk = "asGRisk"),
function(L2FamIC, neighbor, risk, ...){
modIC <- function(L2Fam, IC){
ICL2Fam <- eval(CallL2Fam(IC))
- if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
- sdneu <- main(L2Fam)[2]
- sdalt <- main(ICL2Fam)[2]
+ if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam),
+ class(distribution(ICL2Fam)))){
r <- neighborRadius(IC)
- w <- weight(IC)
- clip(w) <- sdneu*clip(w)/sdalt
- cent(w) <- sdalt*cent(w)/sdneu
- stand(w) <- sdneu^2*stand(w)/sdalt^2
- weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
- biastype = biastype(IC),
- normW = normtype(IC))
- A <- sdneu^2*stand(IC)/sdalt^2
- b <- sdneu*clip(IC)/sdalt
- a <- sdneu*cent(IC)/sdalt
- mse <- sum(diag(A))
- Cov <- sdneu^2*Risks(IC)$asCov/sdalt^2
+ scl.nm <- L2Fam at locscalename["scale"]
- res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
- risk = list(asCov = Cov,
- asMSE = mse, asBias = b,
- trAsCov = mse - r^2*b^2),
- info = Infos(IC), w = w,
- normtype = normtype(IC), biastype = biastype(IC),
- modifyIC = modifyIC(IC))
- IC <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = L2Fam, res = res)
+ if(scl.nm %in% names(main(L2Fam))){
+ sdneu <- main(L2Fam)[scl.nm]
+ sdalt <- main(ICL2Fam)[scl.nm]
+ }else{
+ sdneu <- nuisance(L2Fam)
+ sdalt <- nuisance(ICL2Fam)
+ }
+ res <- scaleUpdateIC(sdneu = sdneu, sdalt = sdalt,
+ IC = IC, neighbor = neighbor)
+
+ IC <- generateIC(neighbor = neighbor, L2Fam = L2Fam, res = res)
addInfo(IC) <- c("modifyIC", "The IC has been modified")
addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
return(IC)
@@ -144,3 +136,4 @@
}
return(modIC)
})
+
Modified: branches/robast-0.7/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -10,7 +10,7 @@
on.exit(options(ow))
if(L2derivDim == 1){
options(warn = -1)
- res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
+ res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
@@ -43,7 +43,7 @@
}
}
options(warn = -1)
- res <- getInfRobIC(L2deriv = L2deriv, neighbor = model at neighbor,
+ res <- getInfRobIC(L2deriv = L2deriv, neighbor = model at neighbor,
risk = risk, Distr = model at center@distribution,
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
L2derivDistrSymm = L2derivDistrSymm, Finfo = model at center@FisherInfo,
Modified: branches/robast-0.7/pkg/ROptEst/chm/00Index.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/00Index.html 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/chm/00Index.html 2009-08-27 15:19:30 UTC (rev 354)
@@ -20,6 +20,7 @@
<a href="#M">M</a>
<a href="#O">O</a>
<a href="#R">R</a>
+<a href="#S">S</a>
<a href="#U">U</a>
</p>
@@ -258,14 +259,12 @@
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2LocationFamily,UncondNeighborhood,fiUnOvShoot-method</a></td>
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
-<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2LocationScaleFamily,ContNeighborhood,asGRisk-method</a></td>
+<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2LocationScaleFamily,UncondNeighborhood,asGRisk-method</a></td>
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2ParamFamily,Neighborhood,asRisk-method</a></td>
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
-<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2ScaleFamily,ContNeighborhood,asGRisk-method</a></td>
+<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2ScaleFamily,UncondNeighborhood,asGRisk-method</a></td>
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
-<tr><td width="25%"><a href="getModifyIC.html">getModifyIC,L2ScaleFamily,TotalVarNeighborhood,asGRisk-method</a></td>
-<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
<tr><td width="25%"><a href="getModifyIC.html">getModifyIC-methods</a></td>
<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
<tr><td width="25%"><a href="getRiskIC.html">getRiskIC</a></td>
@@ -366,6 +365,21 @@
<td>Optimally robust estimation</td></tr>
</table>
+<h2><a name="S">-- S --</a></h2>
+
+<table width="100%">
+<tr><td width="25%"><a href="getModifyIC.html">scaleUpdateIC</a></td>
+<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
+<tr><td width="25%"><a href="getModifyIC.html">scaleUpdateIC,ContNeighborhood-method</a></td>
+<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
+<tr><td width="25%"><a href="getModifyIC.html">scaleUpdateIC,TotalVarNeighborhood-method</a></td>
+<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
+<tr><td width="25%"><a href="getModifyIC.html">scaleUpdateIC,UncondNeighborhood-method</a></td>
+<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
+<tr><td width="25%"><a href="getModifyIC.html">scaleUpdateIC-methods</a></td>
+<td>Generic Function for the Computation of Functions for Slot modifyIC</td></tr>
+</table>
+
<h2><a name="U">-- U --</a></h2>
<table width="100%">
Modified: branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/ROptEst/chm/ROptEst.toc
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/ROptEst.toc 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/chm/ROptEst.toc 2009-08-27 15:19:30 UTC (rev 354)
@@ -434,7 +434,7 @@
<param name="Local" value="getModifyIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="getModifyIC,L2LocationScaleFamily,ContNeighborhood,asGRisk-method">
+<param name="Name" value="getModifyIC,L2LocationScaleFamily,UncondNeighborhood,asGRisk-method">
<param name="Local" value="getModifyIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
@@ -442,14 +442,10 @@
<param name="Local" value="getModifyIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="getModifyIC,L2ScaleFamily,ContNeighborhood,asGRisk-method">
+<param name="Name" value="getModifyIC,L2ScaleFamily,UncondNeighborhood,asGRisk-method">
<param name="Local" value="getModifyIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="getModifyIC,L2ScaleFamily,TotalVarNeighborhood,asGRisk-method">
-<param name="Local" value="getModifyIC.html">
-</OBJECT>
-<LI> <OBJECT type="text/sitemap">
<param name="Name" value="getModifyIC-methods">
<param name="Local" value="getModifyIC.html">
</OBJECT>
@@ -606,6 +602,26 @@
<param name="Local" value="roptest.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="scaleUpdateIC">
+<param name="Local" value="getModifyIC.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="scaleUpdateIC,ContNeighborhood-method">
+<param name="Local" value="getModifyIC.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="scaleUpdateIC,TotalVarNeighborhood-method">
+<param name="Local" value="getModifyIC.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="scaleUpdateIC,UncondNeighborhood-method">
+<param name="Local" value="getModifyIC.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="scaleUpdateIC-methods">
+<param name="Local" value="getModifyIC.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="updateNorm">
<param name="Local" value="updateNorm-methods.html">
</OBJECT>
Modified: branches/robast-0.7/pkg/ROptEst/chm/getModifyIC.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/getModifyIC.html 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/chm/getModifyIC.html 2009-08-27 15:19:30 UTC (rev 354)
@@ -6,13 +6,17 @@
<table width="100%"><tr><td>getModifyIC(ROptEst)</td><td align="right">R Documentation</td></tr></table>
<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: getModifyIC">
+<param name="keyword" value="R: scaleUpdateIC">
<param name="keyword" value="R: getModifyIC-methods">
+<param name="keyword" value="R: scaleUpdateIC-methods">
+<param name="keyword" value="R: scaleUpdateIC,UncondNeighborhood-method">
+<param name="keyword" value="R: scaleUpdateIC,ContNeighborhood-method">
+<param name="keyword" value="R: scaleUpdateIC,TotalVarNeighborhood-method">
<param name="keyword" value="R: getModifyIC,L2ParamFamily,Neighborhood,asRisk-method">
<param name="keyword" value="R: getModifyIC,L2LocationFamily,UncondNeighborhood,asGRisk-method">
<param name="keyword" value="R: getModifyIC,L2LocationFamily,UncondNeighborhood,fiUnOvShoot-method">
-<param name="keyword" value="R: getModifyIC,L2ScaleFamily,ContNeighborhood,asGRisk-method">
-<param name="keyword" value="R: getModifyIC,L2ScaleFamily,TotalVarNeighborhood,asGRisk-method">
-<param name="keyword" value="R: getModifyIC,L2LocationScaleFamily,ContNeighborhood,asGRisk-method">
+<param name="keyword" value="R: getModifyIC,L2ScaleFamily,UncondNeighborhood,asGRisk-method">
+<param name="keyword" value="R: getModifyIC,L2LocationScaleFamily,UncondNeighborhood,asGRisk-method">
<param name="keyword" value=" Generic Function for the Computation of Functions for Slot modifyIC">
</object>
@@ -23,7 +27,7 @@
<h3>Description</h3>
<p>
-This function is used by internal computations and is rarely called directly.
+These function is used by internal computations and is rarely called directly.
</p>
@@ -40,15 +44,20 @@
## S4 method for signature 'L2LocationFamily,UncondNeighborhood,fiUnOvShoot':
getModifyIC(L2FamIC,
neighbor, risk, ...)
-## S4 method for signature 'L2ScaleFamily,ContNeighborhood,asGRisk':
+## S4 method for signature 'L2ScaleFamily,UncondNeighborhood,asGRisk':
getModifyIC(L2FamIC,
neighbor, risk, ...)
-## S4 method for signature 'L2ScaleFamily,TotalVarNeighborhood,asGRisk':
+## S4 method for signature 'L2LocationScaleFamily,UncondNeighborhood,asGRisk':
getModifyIC(L2FamIC,
neighbor, risk, ...)
-## S4 method for signature 'L2LocationScaleFamily,ContNeighborhood,asGRisk':
-getModifyIC(L2FamIC,
- neighbor, risk, ...)
+
+scaleUpdateIC(neighbor,...)
+## S4 method for signature 'UncondNeighborhood':
+scaleUpdateIC(neighbor, sdneu, sdalt, IC)
+## S4 method for signature 'ContNeighborhood':
+scaleUpdateIC(neighbor, sdneu, sdalt, IC)
+## S4 method for signature 'TotalVarNeighborhood':
+scaleUpdateIC(neighbor, sdneu, sdalt, IC)
</pre>
@@ -67,6 +76,15 @@
<tr valign="top"><td><code>...</code></td>
<td>
further arguments to be passed over to <code>optIC</code>.</td></tr>
+<tr valign="top"><td><code>sdneu</code></td>
+<td>
+positive numeric of length one; the new scale.</td></tr>
+<tr valign="top"><td><code>sdalt</code></td>
+<td>
+positive numeric of length one; the new scale.</td></tr>
+<tr valign="top"><td><code>IC</code></td>
+<td>
+a Hampel-IC to be updated.</td></tr>
</table>
@@ -81,7 +99,7 @@
<h3>Value</h3>
-<p> Function for slot <code>modifyIC</code> of <code>IC</code>s </p>
+<p></p>
<h3>Author(s)</h3>
Modified: branches/robast-0.7/pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -173,13 +173,24 @@
(est2 <- oneStepEstimator(x, IC2, est0))
########### again with trafo
+N1.traf <- N1; trafo(N1.traf) <- tfct
N1R.traf <- N1.Rob; trafo(N1R.traf) <- tfct
IC1.traf <- optIC(model = N1R.traf, risk = asMSE())
+(est0.traf <- MDEstimator(x, N1.traf))
(est1.traf <- kStepEstimator(x, IC1.traf, est0, steps = 3))
# or simply
(est2.traf <- oneStepEstimator(x, IC1.traf, est0))
+### main: location; nuisance: scale
+N1.NS <- L2LocationUnknownScaleFamily()
+N1R.NS <- InfRobModel(center = N1.NS, neighbor = ContNeighborhood(radius = 0.5))
+IC1.NS <- optIC(model = N1.NS, risk = asCov())
+IC2.NS <- optIC(model = N1R.NS, risk = asMSE())
+(est0.NS <- MDEstimator(x, N1.NS))
+(est1.NS <- kStepEstimator(x, IC2.NS, est0, steps = 3))
+(est2.NS <- oneStepEstimator(x, IC2.NS, est0))
+
## a simple example
library(MASS)
data(chem)
@@ -200,7 +211,6 @@
confint(ROest2, symmetricBias())
########### again with trafo
-N1.traf <- N1; trafo(N1.traf) <- tfct
system.time(ROest1.traf <- roptest(chem, N1.traf, eps.upper = 0.1, steps = 3L,
initial.est = initial.est, useLast = TRUE))
estimate(ROest1.traf)
Modified: branches/robast-0.7/pkg/ROptEst/man/getModifyIC.Rd
===================================================================
--- branches/robast-0.7/pkg/ROptEst/man/getModifyIC.Rd 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/ROptEst/man/getModifyIC.Rd 2009-08-27 15:19:30 UTC (rev 354)
@@ -1,16 +1,20 @@
\name{getModifyIC}
\alias{getModifyIC}
+\alias{scaleUpdateIC}
\alias{getModifyIC-methods}
+\alias{scaleUpdateIC-methods}
+\alias{scaleUpdateIC,UncondNeighborhood-method}
+\alias{scaleUpdateIC,ContNeighborhood-method}
+\alias{scaleUpdateIC,TotalVarNeighborhood-method}
\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}
+\alias{getModifyIC,L2ScaleFamily,UncondNeighborhood,asGRisk-method}
+\alias{getModifyIC,L2LocationScaleFamily,UncondNeighborhood,asGRisk-method}
\title{Generic Function for the Computation of Functions for Slot modifyIC}
\description{
- This function is used by internal computations and is rarely called directly.
+ These function is used by internal computations and is rarely called directly.
}
\usage{
getModifyIC(L2FamIC, neighbor, risk,...)
@@ -20,25 +24,35 @@
neighbor, risk, ...)
\S4method{getModifyIC}{L2LocationFamily,UncondNeighborhood,fiUnOvShoot}(L2FamIC,
neighbor, risk, ...)
-\S4method{getModifyIC}{L2ScaleFamily,ContNeighborhood,asGRisk}(L2FamIC,
+\S4method{getModifyIC}{L2ScaleFamily,UncondNeighborhood,asGRisk}(L2FamIC,
neighbor, risk, ...)
-\S4method{getModifyIC}{L2ScaleFamily,TotalVarNeighborhood,asGRisk}(L2FamIC,
+\S4method{getModifyIC}{L2LocationScaleFamily,UncondNeighborhood,asGRisk}(L2FamIC,
neighbor, risk, ...)
-\S4method{getModifyIC}{L2LocationScaleFamily,ContNeighborhood,asGRisk}(L2FamIC,
- neighbor, risk, ...)
+
+scaleUpdateIC(neighbor,...)
+\S4method{scaleUpdateIC}{UncondNeighborhood}(neighbor, sdneu, sdalt, IC)
+\S4method{scaleUpdateIC}{ContNeighborhood}(neighbor, sdneu, sdalt, IC)
+\S4method{scaleUpdateIC}{TotalVarNeighborhood}(neighbor, sdneu, sdalt, IC)
}
\arguments{
\item{L2FamIC}{ object of class \code{L2ParamFamily}. }
\item{neighbor}{ object of class \code{"Neighborhood"}. }
\item{risk}{ object of class \code{"RiskType"} }
\item{\dots}{further arguments to be passed over to \code{optIC}.}
+ \item{sdneu}{positive numeric of length one; the new scale.}
+ \item{sdalt}{positive numeric of length one; the new scale.}
+ \item{IC}{a Hampel-IC to be updated.}
}
\details{ This function is used for internal computations.
By setting \code{RobAStBaseOption("all.verbose" = TRUE)} somewhere
globally, the generated function \code{modifyIC} will generate
calls to \code{optIC} with argument \code{verbose=TRUE}.
}
-\value{ Function for slot \code{modifyIC} of \code{IC}s }
+\value{\describe{
+\item{getmodifyIC}{Function for slot \code{modifyIC} of \code{IC}s}
+\item{scaleUpdateIC}{a list to be digested in corresponding methods
+of \code{getmodifyIC} by \code{generateIC}}
+ }}
\references{
Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
Modified: branches/robast-0.7/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/NAMESPACE 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/RobAStBase/NAMESPACE 2009-08-27 15:19:30 UTC (rev 354)
@@ -20,7 +20,7 @@
exportClasses("cutoff")
exportMethods("show",
"plot")
-exportMethods("type", "radius")
+exportMethods("type", "radius", "radius<-")
exportMethods("name", "name<-",
"infoPlot")
exportMethods("center", "center<-",
Modified: branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -1,7 +1,10 @@
if(!isGeneric("radius")){
setGeneric("radius", function(object) standardGeneric("radius"))
}
-if(!isGeneric("center")){
+if(!isGeneric("radius<-")){
+ setGeneric("radius<-", function(object,value) standardGeneric("radius<-"))
+}
+if(!isGeneric("center")){
setGeneric("center", function(object) standardGeneric("center"))
}
if(!isGeneric("center<-")){
Modified: branches/robast-0.7/pkg/RobAStBase/R/Neighborhood.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/Neighborhood.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/RobAStBase/R/Neighborhood.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -1,3 +1,7 @@
## access method
setMethod("type", "Neighborhood", function(object) object at type)
setMethod("radius", "Neighborhood", function(object) object at radius)
+## Replace method
+setReplaceMethod("radius", "Neighborhood",
+ function(object, value){object at radius <- value
+ object})
Modified: branches/robast-0.7/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/kStepEstimator.R 2009-08-26 02:38:36 UTC (rev 353)
+++ branches/robast-0.7/pkg/RobAStBase/R/kStepEstimator.R 2009-08-27 15:19:30 UTC (rev 354)
@@ -2,10 +2,10 @@
## k-step estimator
###############################################################################
-### helper function from distrMod:
+### helper functions from distrMod:
.isUnitMatrix <- distrMod:::.isUnitMatrix
+.deleteDim <- distrMod:::.deleteDim
-
### no dispatch on top layer -> keep product structure of dependence
kStepEstimator <- function(x, IC, start, steps = 1L,
useLast = getRobAStBaseOption("kStepUseLast"),
@@ -13,19 +13,39 @@
IC.UpdateInKer = getRobAStBaseOption("IC.UpdateInKer"),
na.rm = TRUE, ...){
## save call
-
es.call <- match.call()
es.call[[1]] <- as.name("kStepEstimator")
## get some dimensions
L2Fam <- eval(CallL2Fam(IC))
Param <- param(L2Fam)
+
tf <- trafo(L2Fam,Param)
Dtau <- tf$mat
trafoF <- tf$fct
+
+ hasnodim.main <- is.null(dim(main(L2Fam)))
+ hasnodim.nuis <- is.null(dim(nuisance(L2Fam)))
+
p <- nrow(Dtau)
k <- ncol(Dtau)
+ lmx <- length(main(L2Fam))
+ lnx <- length(nuisance(L2Fam))
+ idx <- 1:lmx
+ nuis.idx <- if(lnx) lmx + 1:lnx else NULL
+
+ var.to.be.c <- ("asCov" %in% names(Risks(IC))) | (lnx == 0)
+
+ fixed <- fixed(L2Fam)
+
+## names of the estimator components
+ par.names <- names(main(L2Fam))
+ if(lnx)
+ par.names <- c(par.names, names(nuisance(L2Fam)) )
+ est.names <- if(.isUnitMatrix(Dtau)) par.names else rownames(Dtau)
+ u.est.names <- par.names
+
## check input
if(!is.integer(steps))
steps <- as.integer(steps)
@@ -43,7 +63,8 @@
if(na.rm) x0 <- na.omit(x0)
### use dispatch here (dispatch only on start)
-
+ a.var <- if( is(start, "Estimate")) asvar(start) else NULL
+ IC.UpdateInKer.0 <- if(is(start,"ALEstimate")) start at pIC else NULL
start.val <- kStepEstimator.start(start, x=x0, nrvalues = k, na.rm = na.rm, ...)
@@ -53,7 +74,8 @@
else trafoF(u.theta)$fval
### update - function
- updateStep <- function(u.theta, theta, IC, L2Fam, Param, withModif = TRUE){
+ updateStep <- function(u.theta, theta, IC, L2Fam, Param,
+ withModif = TRUE, with.u.var = FALSE){
IC.c <- as(diag(p) %*% IC at Curve, "EuclRandVariable")
@@ -61,27 +83,33 @@
theta <- theta + rowMeans(evalRandVar(IC.c, x0),
na.rm = na.rm )
+# print(theta)
tf <- trafo(L2Fam, Param)
Dtau <- tf$mat
-
+ IC.tot.0 <- NULL
+# print(Dtau)
if(!.isUnitMatrix(Dtau)){
Dminus <- solve(Dtau, generalized = TRUE)
- projtau <- diag(k) - Dminus %*% Dtau
+ projker <- diag(k) - Dminus %*% Dtau
IC.tot1 <- Dminus %*% IC.c
IC.tot2 <- 0 * IC.tot1
- if(sum(diag(projtau))>0.5 && ### is EM-D^-D != 0 (i.e. rk D<p)
+ if(sum(diag(projker))>0.5 && ### is EM-D^-D != 0 (i.e. rk D<p)
withUpdateInKer){
if(!is.null(IC.UpdateInKer)&&!is(IC.UpdateInKer,"IC"))
warning("'IC.UpdateInKer' is not of class 'IC'; we use default instead.")
IC.tot2 <- if(is.null(IC.UpdateInKer))
- getBoundedIC(L2Fam, D = projtau) else
- as(projtau %*% IC.UpdateInKer at Curve,
+ getBoundedIC(L2Fam, D = projker) else
+ as(projker %*% IC.UpdateInKer at Curve,
"EuclRandVariable")
+ IC.tot.0 <- IC.tot1 + IC.tot2
+ }else{
+ IC.tot.0 <- if(!is.null(IC.UpdateInKer.0))
+ IC.tot1 + as(projker %*% IC.UpdateInKer.0 at Curve,
+ "EuclRandVariable") else NULL
}
IC.tot <- IC.tot1 + IC.tot2
-
u.theta <- u.theta + rowMeans(evalRandVar(IC.tot, x0),
na.rm = na.rm)
}else{
@@ -89,18 +117,29 @@
u.theta <- theta
}
- cnms <- if(is.null(names(u.theta))) colnames(Dtau) else names(u.theta)
- u.var <- matrix(E(L2Fam, IC.tot %*% t(IC.tot)),
+ var0 <- u.var <- NULL
+ if(with.u.var){
+ cnms <- if(is.null(names(u.theta))) colnames(Dtau) else names(u.theta)
+ if(!is.null(IC.tot.0))
+ u.var <- matrix(E(L2Fam, IC.tot.0 %*% t(IC.tot.0)),
k,k, dimnames = list(cnms,cnms))
+ if(!var.to.be.c)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 354
More information about the Robast-commits
mailing list