Nothing
###############################################################################
## asymptotic Bias for various types
###############################################################################
setMethod("getBiasIC", signature(IC = "IC",
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam, biastype = symmetricBias(),
normtype = NormType(), tol = .Machine$double.eps^0.25,
numbeval = 1e5, withCheck = TRUE, ...){
misF <- FALSE
if(missing(L2Fam)){
misF <- TRUE
L2Fam <- eval(IC@CallL2Fam)
}
if(missing(withCheck)) withCheck <- TRUE
D1 <- L2Fam@distribution
if(dimension(Domain(IC@Curve[[1]])) != dimension(img(D1)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
x <- as.matrix(r(D1)(numbeval))
x <- as.matrix(x[!duplicated(x),])
Bias <- .evalBiasIC(IC = IC, neighbor = neighbor, biastype = biastype,
normtype = normtype, x = x, trafo = trafo(L2Fam@param))
if(withCheck) if(misF) .checkICWithWarning(IC, tol=tol, ...) else .checkICWithWarning(IC, L2Fam, tol=tol, ...)
return(list(asBias = list(distribution = .getDistr(L2Fam),
neighborhood = neighbor@type, value = Bias)))
})
### help functions ( not exported to namespace) for getRiskIC
setMethod(".evalBiasIC", signature(IC = "IC",
neighbor = "ContNeighborhood",
biastype = "BiasType"),
function(IC, neighbor, biastype, normtype, x, trafo){
ICx <- evalRandVar(as(diag(dimension(IC@Curve)) %*% IC@Curve,
"EuclRandVariable"),x)[,,1]
return(max(fct(normtype)(ICx)))}
)
setMethod(".evalBiasIC", signature(IC = "IC",
neighbor = "TotalVarNeighborhood",
biastype = "BiasType"),
function(IC, neighbor, biastype, normtype, x, trafo){
if(nrow(trafo) > 1)
stop("not yet implemented for dimension > 1")
IC1 <- as(diag(nrow(trafo)) %*% IC@Curve, "EuclRandVariable")
res <- evalRandVar(IC1, x)
return(max(res) - min(res))}
)
setMethod(".evalBiasIC", signature(IC = "IC",
neighbor = "ContNeighborhood",
biastype = "onesidedBias"),
function(IC, neighbor, biastype, x, trafo){
if(nrow(trafo) > 1)
stop("not yet implemented for dimension > 1")
IC1 <- as(diag(nrow(trafo)) %*% IC@Curve, "EuclRandVariable")
res <- evalRandVar(IC1, x)
if (sign(biastype)>0)
return(max(res))
else return(-min(res))
})
setMethod(".evalBiasIC", signature(IC = "IC",
neighbor = "ContNeighborhood",
biastype = "asymmetricBias"),
function(IC, neighbor, biastype, x, trafo){
if(nrow(trafo) > 1)
stop("not yet implemented for dimension > 1")
IC1 <- as(diag(nrow(trafo)) %*% IC@Curve, "EuclRandVariable")
res <- evalRandVar(IC1, x)
return(max(res)/nu(biastype)[2] -
min(res)/nu(biastype)[1])}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.