# R/getRiskIC.R In ROptEst: Optimally Robust Estimation

#### Defines functions checkICWithWarning

.checkICWithWarning <- function(IC, L2Fam, tol, ...){
if(!missing(L2Fam)){
prec <- checkIC(IC, L2Fam, out = FALSE, ...)
}else{
prec <- checkIC(IC, out = FALSE, ...)
}
if(prec > tol)
warning("The maximum deviation from the exact IC properties is ", prec,
"\nThis is larger than the specified 'tol' ",
"=> the result may be wrong")
}

###############################################################################
## asymptotic covariance
###############################################################################
setMethod("getRiskIC", signature(IC = "HampIC",
risk = "asCov",
neighbor = "missing",
L2Fam = "missing"),
function(IC, risk, withCheck= TRUE, ...){
L2Fam <- force(eval(IC@CallL2Fam))
if(missing(withCheck)) withCheck <- TRUE
getRiskIC(IC = IC, risk = risk, L2Fam = L2Fam, withCheck= withCheck, ...)
})

setMethod("getRiskIC", signature(IC = "HampIC",
risk = "asCov",
neighbor = "missing",
L2Fam = "L2ParamFamily"),
function(IC, risk, L2Fam, withCheck= TRUE, ...){
if(missing(withCheck)) withCheck <- TRUE
Cov <- eval(IC@Risks[["asCov"]])
if(is.null(Cov)){
if(numberOfMaps(L2Fam@L2deriv)==1){ ## L2derivDim <- [email protected]
L2deriv <- L2Fam@L2derivDistr[[1]]
A <- as.vector(IC@stand)
c0 <- IC@clip/abs(A)
z <- IC@cent/A
neighbor <- ContNeighborhood(1)
Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype(IC), clip = c0, cent = z, stand = A)
if(withCheck) .checkICWithWarning(IC, L2Fam, tol=.Machine\$double.eps^.25, ...)
return(list(asCov = list(distribution = .getDistr(L2Fam),
value = Cov)))
}
return(getRiskIC(as(IC, "IC"), risk = risk, L2Fam = L2Fam, withCheck= withCheck, ...))
}else
return(list(asCov = list(distribution = .getDistr(L2Fam), value = Cov)))
})

setMethod("getRiskIC", signature(IC = "TotalVarIC",
risk = "asCov",
neighbor = "missing",
L2Fam = "L2ParamFamily"),
function(IC, risk, L2Fam, withCheck = TRUE, ...){
Cov <- eval(IC@Risks[["asCov"]])
if(missing(withCheck)) withCheck <- TRUE
if (is.null(Cov)){
L2deriv <- L2Fam@L2derivDistr[[1]]
A <- as.vector(IC@stand)
c0 <- (IC@clipUp-IC@clipLo)/abs(A)
z <- IC@clipLo/abs(A)
neighbor <- TotalVarNeighborhood(1)
if(withCheck) .checkICWithWarning(IC, L2Fam, tol=.Machine\$double.eps^.25, ...)
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
###############################################################################
setMethod("getBiasIC", signature(IC = "HampIC",
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam,...){
if(missing(L2Fam))
L2Fam <- force(eval(IC@CallL2Fam))

Bias <- IC@Risks\$asBias\$value

return(list(asBias = list(distribution = .getDistr(L2Fam),
neighborhood = neighbor@type, value = Bias)))
})

setMethod("getBiasIC", signature(IC = "TotalVarIC",
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam,...){
if(missing(L2Fam))
L2Fam <- force(eval(IC@CallL2Fam))

Bias <- IC@Risks\$asBias\$value
if (is.null(Bias)){
Bias <- if(is(neighbor,"ContNeighborhood"))
max(IC@clipUp,-IC@clipLo) else IC@clipUp-IC@clipLo
}

return(list(asBias = list(distribution = .getDistr(L2Fam),
neighborhood = neighbor@type, value = Bias)))
})

## Try the ROptEst package in your browser

Any scripts or data that you put into this service are public.

ROptEst documentation built on April 6, 2019, 3:01 a.m.