Nothing
###############################################################################
## gamma in case of a convex asymptotic risk and
## (unconditional) contamination neighborhoods (* = c)
###############################################################################
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
risk = "asMSE",
neighbor = "ContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
print("falsch")
Gfct <- function(x, cent, clip, D1){
if(x == 0) return(max(abs(cent) - clip, 0))
c1 <- cent/x - clip/abs(x)
c2 <- cent/x + clip/abs(x)
return(abs(x)*(m1df(D1, c2) + m1df(D1, c1) - c1*p(D1)(c1) + c2*(1-p(D1)(c2))))
}
return(E(Regressor, Gfct, cent = cent, clip = clip, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "MultivariateDistribution",
risk = "asMSE",
neighbor = "ContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
if(z.comp){
Gfct.z <- function(x, stand, cent, clip, D1){
Gfctu <- function(u, xx, stand, cent, clip){
v <- as.vector(stand %*% (xx*u - cent))
res <- as.vector(sqrt(v %*% v)) - clip
return((res > 0)*res)
}
E(D1, Gfctu, xx = x, stand = stand, cent = cent, clip = clip)
}
return(-E(Regressor, Gfct.z, stand = stand, cent = cent, clip = clip, D1 = ErrorL2deriv))
}else{
Gfct <- function(x, stand, clip, D1){
v <- t(x) %*% stand
v <- as.vector(sqrt(v %*% t(v)))
c0 <- clip/v
return(v*(m1df(D1, c0) + m1df(D1, -c0) + 2*c0*p(D1)(-c0)))
}
return(E(Regressor, Gfct, stand = stand, clip = clip, D1 = ErrorL2deriv))
}
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
risk = "asMSE",
neighbor = "Av1CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
Gfct <- function(x, cent, clip, D1){
if(x == 0) return(max(abs(cent(x)) - clip, 0))
c1 <- cent(x) - clip/abs(x)
c2 <- cent(x) + clip/abs(x)
return(abs(x)*(m1df(D1, c2) + m1df(D1, c1) - c1*p(D1)(c1) + c2*(1-p(D1)(c2))))
}
return(E(Regressor, Gfct, cent = cent, clip = clip, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "MultivariateDistribution",
risk = "asMSE",
neighbor = "Av1CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
if(z.comp){
Gfct.z <- function(x, stand, cent, clip, D1){
Gfctu <- function(u, xx, stand, cent, clip){
v <- as.vector(stand %*% xx*(u - cent(xx)))
res <- as.vector(sqrt(v %*% v)) - clip
return((res > 0)*res)
}
E(D1, Gfctu, xx = x, stand = stand, cent = cent, clip = clip)
}
return(-E(Regressor, Gfct.z, stand = stand, cent = cent, clip = clip, D1 = ErrorL2deriv))
}else{
Gfct <- function(x, stand, clip, D1){
v <- t(x) %*% stand
v <- as.vector(sqrt(v %*% t(v)))
c0 <- clip/v
return(v*(m1df(D1, c0) + m1df(D1, -c0) + 2*c0*p(D1)(-c0)))
}
return(E(Regressor, Gfct, stand = stand, clip = clip, D1 = ErrorL2deriv))
}
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "Distribution",
risk = "asMSE",
neighbor = "Av2CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
c1 <- cent - clip
c2 <- cent + clip
return(m1df(ErrorL2deriv, c2) + m1df(ErrorL2deriv, c1)
- c1*p(ErrorL2deriv)(c1) + c2*(1-p(ErrorL2deriv)(c2)))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
risk = "asMSE",
neighbor = "Av1CondTotalVarNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
Gfct <- function(x, cent, clip, D1){
if(x == 0) return(0)
c0 <- (cent(x) + clip)/abs(x)
return((m1df(D1, c0) + c0*(1-p(D1)(c0)))*abs(x))
}
return(E(Regressor, Gfct, cent = cent, clip = clip, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "MultivariateDistribution",
risk = "asMSE",
neighbor = "Av1CondTotalVarNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, z.comp, stand, cent, clip){
Gfct <- function(x, cent, clip, stand, D1){
if(all(x == numeric(length(x)))) return(0)
v <- as.vector(sqrt(sum((stand %*% x)^2)))
c0 <- (cent(x) + clip)/v
return((m1df(D1, c0) + c0*(1-p(D1)(c0)))*v)
}
return(E(Regressor, Gfct, cent = cent, clip = clip, stand = stand, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "RealRandVariable",
Regressor = "Distribution",
risk = "asMSE",
neighbor = "ContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorDistr, stand, cent, clip){
integrandGu <- function(u, xx, ErrorL2deriv, A, z, b, k0){
L1 <- as.vector(evalRandVar(ErrorL2deriv, u))
L <- c(xx*L1[1], L1[2:k0])
Y <- A %*% (L - z)
res <- as.vector(sqrt(sum(Y^2))) - b
return((res > 0)*res)
}
integrandGx <- function(x, ErrorL2deriv, ErrorDistr, stand, cent, clip, k0){
E(object = ErrorDistr, fun = integrandGu, xx = x,
ErrorL2deriv = ErrorL2deriv, A = stand, z = cent, b = clip, k0 = k0)
}
k <- length(ErrorL2deriv)
return(-E(object = Regressor, fun = integrandGx, ErrorL2deriv = ErrorL2deriv,
ErrorDistr = ErrorDistr, stand = stand, cent = cent, clip = clip, k0 = k))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "RealRandVariable",
Regressor = "Distribution",
risk = "asMSE",
neighbor = "Av1CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorDistr, stand, cent, clip){
k <- length(ErrorL2deriv)
integrandGu <- function(u, xx, ErrorL2deriv, A, z, b, k0){
L1 <- as.vector(evalRandVar(ErrorL2deriv, u))
z1 <- z(xx)
L <- c(xx*L1[1]-z1[1], L1[2:k0]-z1[2:k0])
Y <- as.vector(A %*% L)
res <- as.vector(sqrt(sum(Y^2))) - b
return((res > 0)*res)
}
integrandGx <- function(x, ErrorL2deriv, ErrorDistr, stand, cent, clip, k0){
E(object = ErrorDistr, fun = integrandGu, xx = x,
ErrorL2deriv = ErrorL2deriv, A = stand, z = cent, b = clip, k0 = k0)
}
return(-E(object = Regressor, fun = integrandGx, ErrorL2deriv = ErrorL2deriv,
ErrorDistr = ErrorDistr, stand = stand, cent = cent, clip = clip, k0 = k))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
risk = "asUnOvShoot",
neighbor = "ContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, cent, clip){
Gfct <- function(x, cent, clip, D1){
if(x == 0) return(max(-(cent + clip), 0))
c1 <- (cent + clip)/x
return(max(x,0)*(m1df(D1, c1) + c1*(1-p(D1)(c1)))
- min(x, 0)*(m1df(D1, c1) - c1*p(D1)(c1)))
}
return(2*E(Regressor, Gfct, cent = cent, clip = clip, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
risk = "asUnOvShoot",
neighbor = "TotalVarNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, cent, clip){
Gfct <- function(x, cent, clip, D1){
if(x == 0) return(0)
c1 <- (cent + clip)/x
return(max(x,0)*(m1df(D1, c1) + c1*(1-p(D1)(c1)))
- min(x, 0)*(m1df(D1, c1) - c1*p(D1)(c1)))
}
return(E(Regressor, Gfct, cent = cent, clip = clip, D1 = ErrorL2deriv))
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "numeric",
risk = "asUnOvShoot",
neighbor = "CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, clip){
bx <- clip/Regressor
if(Regressor > 0){
return(2*(Regressor*m1df(ErrorL2deriv, bx) + clip*(1 - p(ErrorL2deriv)(bx))))
}else{
return(-2*(Regressor*m1df(ErrorL2deriv, bx) - clip*p(ErrorL2deriv)(bx)))
}
})
setMethod("getInfGammaRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "numeric",
risk = "asUnOvShoot",
neighbor = "CondTotalVarNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, clip){
bx <- clip/Regressor
if(Regressor > 0){
return(Regressor*m1df(ErrorL2deriv, bx) + clip*(1 - p(ErrorL2deriv)(bx)))
}else{
return(-(Regressor*m1df(ErrorL2deriv, bx) - clip*p(ErrorL2deriv)(bx)))
}
})
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.