Nothing
###############################################################################
## standardizing matrix for asymptotic G-Risk
###############################################################################
setMethod("getInfStand", signature(L2deriv = "UnivariateDistribution",
neighbor = "ContNeighborhood",
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, clip, cent, trafo){
c1 <- cent - clip
c2 <- cent + clip
return(trafo/(m2df(L2deriv, c2) - m2df(L2deriv, c1)
+ c1*m1df(L2deriv, c1) - c2*m1df(L2deriv, c2)))
})
setMethod("getInfStand", signature(L2deriv = "UnivariateDistribution",
neighbor = "TotalVarNeighborhood",
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, clip, cent, trafo){
D1 <- sign(as.vector(trafo))*L2deriv
return(trafo/(m2df(D1, cent+clip) - m2df(D1, cent) + cent*m1df(D1, cent)
- (cent+clip)*m1df(D1, cent+clip)))
})
setMethod("getInfStand", signature(L2deriv = "RealRandVariable",
neighbor = "UncondNeighborhood",
biastype = "BiasType"),
function(L2deriv, neighbor, biastype,
Distr, A.comp, cent, trafo, w, ...){
dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
w.fct <- function(x){
weight(w)(evalRandVar(L2deriv, as.matrix(x)) [,,1])
}
integrandA <- function(x, L2.i, L2.j, i, j){
return((L2.i(x) - cent[i])*(L2.j(x) - cent[j])*w.fct(x = x))
}
nrvalues <- length(L2deriv)
erg <- matrix(0, ncol = nrvalues, nrow = nrvalues)
for(i in 1:nrvalues)
for(j in i:nrvalues)
if(A.comp[i,j]){
integrandAij <- function(x) integrandA(x,L2.i = L2deriv@Map[[i]],
L2.j = L2deriv@Map[[j]], i = i, j = j)
erg[i, j] <- do.call(E, c(list(object = Distr, fun = integrandAij),
dotsI))
}
erg[col(erg) < row(erg)] <- t(erg)[col(erg) < row(erg)]
return(trafo %*% distr::solve(erg))
})
###############################################################################
## standardizing constant for one-sided bias
###############################################################################
setMethod("getInfStand", signature(L2deriv = "UnivariateDistribution",
neighbor = "ContNeighborhood",
biastype = "onesidedBias"),
function(L2deriv, neighbor, biastype, clip, cent, trafo, ...){
dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
c1 <- if (sign(biastype)<0) cent - clip else -Inf
c2 <- if (sign(biastype)>0) cent + clip else Inf
m1 <- if (sign(biastype)<0) m2df(L2deriv, c1) else 0
m2 <- if (sign(biastype)>0) m2df(L2deriv, c2) else{
do.call(E, c(list(L2deriv, function(x)x^2),dotsI))}
c10 <- if (sign(biastype)<0) c1*m1df(L2deriv, c1) else 0
c20 <- if (sign(biastype)>0) c2*m1df(L2deriv, c2) else 0
return(trafo/(m2 - m1 + c10 - c20))
})
###############################################################################
## standardizing constant for asymmetric bias
###############################################################################
setMethod("getInfStand", signature(L2deriv = "UnivariateDistribution",
neighbor = "ContNeighborhood",
biastype = "asymmetricBias"),
function(L2deriv, neighbor, biastype, clip, cent, trafo){
nu1 <- nu(biastype)[1]
nu2 <- nu(biastype)[2]
c1 <- cent - clip/nu1
c2 <- cent + clip/nu2
return(trafo/(m2df(L2deriv, c2) - m2df(L2deriv, c1)
+ c1*m1df(L2deriv, c1) - c2*m1df(L2deriv, c2)))
})
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.