[Robast-commits] r1188 - in pkg: ROptEstOld ROptEstOld/R ROptEstOld/inst ROptRegTS ROptRegTS/R ROptRegTS/inst RobRex RobRex/R RobRex/inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 2 17:07:42 CET 2019
Author: ruckdeschel
Date: 2019-03-02 17:07:41 +0100 (Sat, 02 Mar 2019)
New Revision: 1188
Modified:
pkg/ROptEstOld/DESCRIPTION
pkg/ROptEstOld/R/getInfRobIC_asCov.R
pkg/ROptEstOld/R/getInfRobIC_asHampel.R
pkg/ROptEstOld/R/getInfStand.R
pkg/ROptEstOld/R/infoPlot.R
pkg/ROptEstOld/R/leastFavorableRadius.R
pkg/ROptEstOld/R/optIC.R
pkg/ROptEstOld/R/optRisk.R
pkg/ROptEstOld/R/radiusMinimaxIC.R
pkg/ROptEstOld/inst/NEWS
pkg/ROptRegTS/DESCRIPTION
pkg/ROptRegTS/R/Av2CondContIC.R
pkg/ROptRegTS/R/CondIC.R
pkg/ROptRegTS/R/Expectation.R
pkg/ROptRegTS/R/L2RegTypeFamily.R
pkg/ROptRegTS/R/getAsRiskRegTS.R
pkg/ROptRegTS/R/getIneffDiff.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c2.R
pkg/ROptRegTS/R/getInfStandRegTS.R
pkg/ROptRegTS/R/leastFavorableRadius.R
pkg/ROptRegTS/R/optIC.R
pkg/ROptRegTS/R/radiusMinimaxIC.R
pkg/ROptRegTS/inst/NEWS
pkg/RobRex/DESCRIPTION
pkg/RobRex/R/rgsOptIC_AL.R
pkg/RobRex/R/rgsOptIC_ALc.R
pkg/RobRex/R/rgsOptIC_ALs.R
pkg/RobRex/R/rgsOptIC_M.R
pkg/RobRex/R/rgsOptIC_MK.R
pkg/RobRex/inst/NEWS
Log:
preparation for release of 1.2: merged back ROptEstOld, ROptRegTS and RobRex from branch 1.2 to trunk
Modified: pkg/ROptEstOld/DESCRIPTION
===================================================================
--- pkg/ROptEstOld/DESCRIPTION 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/DESCRIPTION 2019-03-02 16:07:41 UTC (rev 1188)
@@ -1,6 +1,6 @@
Package: ROptEstOld
-Version: 1.1.0
-Date: 2018-08-01
+Version: 1.2.0
+Date: 2019-03-01
Title: Optimally Robust Estimation - Old Version
Description: Optimally robust estimation using S4 classes and methods. Old version still needed
for current versions of ROptRegTS and RobRex.
@@ -13,4 +13,4 @@
Encoding: latin1
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1081
+VCS/SVNRevision: 1178
Modified: pkg/ROptEstOld/R/getInfRobIC_asCov.R
===================================================================
--- pkg/ROptEstOld/R/getInfRobIC_asCov.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/getInfRobIC_asCov.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -6,7 +6,7 @@
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- abs(as.vector(A))*max(abs(q.l(L2deriv)(1)),abs(q.l(L2deriv)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
@@ -17,7 +17,7 @@
neighbor = "TotalVarNeighborhood"),
function(L2deriv, risk, neighbor, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- abs(as.vector(A))*(q.l(L2deriv)(1)-q.l(L2deriv)(0))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
@@ -28,7 +28,7 @@
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor, Distr, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
IC <- A %*% L2deriv
if(is(Distr, "UnivariateDistribution")){
lower <- ifelse(is.finite(q.l(Distr)(0)), q.l(Distr)(1e-8), q.l(Distr)(0))
Modified: pkg/ROptEstOld/R/getInfRobIC_asHampel.R
===================================================================
--- pkg/ROptEstOld/R/getInfRobIC_asHampel.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/getInfRobIC_asHampel.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -69,7 +69,7 @@
if(is.null(z.start)) z.start <- numeric(ncol(trafo))
if(is.null(A.start)) A.start <- trafo
- ClassIC <- trafo %*% solve(Finfo) %*% L2deriv
+ ClassIC <- trafo %*% distr::solve(Finfo) %*% L2deriv
lower <- q.l(Distr)(getdistrOption("TruncQuantile"))
upper <- q.l(Distr)(1-getdistrOption("TruncQuantile"))
x <- seq(from = lower, to = upper, by = 0.01)
Modified: pkg/ROptEstOld/R/getInfStand.R
===================================================================
--- pkg/ROptEstOld/R/getInfStand.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/getInfStand.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -46,5 +46,5 @@
erg[col(erg) < row(erg)] <- erg[col(erg) > row(erg)]
- return(trafo %*% solve(erg))
+ return(trafo %*% distr::solve(erg))
})
Modified: pkg/ROptEstOld/R/infoPlot.R
===================================================================
--- pkg/ROptEstOld/R/infoPlot.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/infoPlot.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -22,7 +22,7 @@
trafo <- L2Fam at param@trafo
dims <- nrow(trafo)
- classIC <- as(trafo %*% solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
+ classIC <- as(trafo %*% distr::solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
absInfoClass <- classIC %*% classIC
absInfoClass <- sapply(x.vec, absInfoClass at Map[[1]])
IC1 <- as(diag(dims) %*% object at Curve, "EuclRandVariable")
Modified: pkg/ROptEstOld/R/leastFavorableRadius.R
===================================================================
--- pkg/ROptEstOld/R/leastFavorableRadius.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/leastFavorableRadius.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -109,7 +109,7 @@
trafo <- L2Fam at param@trafo
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
- loRisk <- sum(diag(solve(L2Fam at FisherInfo)))
+ loRisk <- sum(diag(distr::solve(L2Fam at FisherInfo)))
}else{
neighbor at radius <- loRad
resLo <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
Modified: pkg/ROptEstOld/R/optIC.R
===================================================================
--- pkg/ROptEstOld/R/optIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/optIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -3,8 +3,8 @@
###############################################################################
setMethod("optIC", signature(model = "L2ParamFamily", risk = "asCov"),
function(model, risk){
- Curve <- as((model at param@trafo %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
- asCov <- model at param@trafo %*% solve(model at FisherInfo) %*% t(model at param@trafo)
+ Curve <- as((model at param@trafo %*% distr::solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
+ asCov <- model at param@trafo %*% distr::solve(model at FisherInfo) %*% t(model at param@trafo)
return(IC(
name = paste("Classical optimal influence curve for", model at name),
Modified: pkg/ROptEstOld/R/optRisk.R
===================================================================
--- pkg/ROptEstOld/R/optRisk.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/optRisk.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -3,7 +3,7 @@
###############################################################################
setMethod("optRisk", signature(model = "L2ParamFamily", risk = "asCov"),
function(model, risk){
- return(list(asCov = solve(model at FisherInfo)))
+ return(list(asCov = distr::solve(model at FisherInfo)))
})
###############################################################################
Modified: pkg/ROptEstOld/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptEstOld/R/radiusMinimaxIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/R/radiusMinimaxIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -105,7 +105,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
- loRisk <- sum(diag(solve(L2Fam at FisherInfo)))
+ loRisk <- sum(diag(distr::solve(L2Fam at FisherInfo)))
}else{
neighbor at radius <- loRad
resLo <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
Modified: pkg/ROptEstOld/inst/NEWS
===================================================================
--- pkg/ROptEstOld/inst/NEWS 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptEstOld/inst/NEWS 2019-03-02 16:07:41 UTC (rev 1188)
@@ -8,6 +8,13 @@
information)
#######################################
+version 1.2
+#######################################
+
+under the hood
++ now specified that we want to use distr::solve
+
+#######################################
version 1.1
#######################################
Modified: pkg/ROptRegTS/DESCRIPTION
===================================================================
--- pkg/ROptRegTS/DESCRIPTION 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/DESCRIPTION 2019-03-02 16:07:41 UTC (rev 1188)
@@ -1,6 +1,6 @@
Package: ROptRegTS
-Version: 1.1.0
-Date: 2018-08-01
+Version: 1.2.0
+Date: 2019-03-01
Title: Optimally Robust Estimation for Regression-Type Models
Description: Optimally robust estimation for regression-type models using S4 classes and
methods.
@@ -15,4 +15,4 @@
URL: http://robast.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1081
+VCS/SVNRevision: 1178
Modified: pkg/ROptRegTS/R/Av2CondContIC.R
===================================================================
--- pkg/ROptRegTS/R/Av2CondContIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/Av2CondContIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -29,7 +29,7 @@
ICfct <- vector(mode = "list", length = 1)
L2 <- L2Fam at ErrorL2deriv[[1]]
k <- dimension(img(L2Fam at RegDistr))
- K.inv <- solve(E(L2Fam at RegDistr, fun = function(x){ x %*% t(x) }))
+ K.inv <- distr::solve(E(L2Fam at RegDistr, fun = function(x){ x %*% t(x) }))
trafo <- L2Fam at param@trafo
if(!is.null(d)){
Modified: pkg/ROptRegTS/R/CondIC.R
===================================================================
--- pkg/ROptRegTS/R/CondIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/CondIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -41,9 +41,8 @@
IC1 <- as(diag(nrow(trafo)) %*% IC at Curve, "EuclRandVariable")
cent <- array(0, c(length(IC1), length(cond), nrow(trafo)))
for(i in 1:length(IC1)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC1 at Map[[i]])
+ fct <- function(x, cond){ IC1 at Map[[i]](cbind(t(cond),x)) }
+ cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct)
}
if(out)
cat("precision of conditional centering:\t", max(abs(cent)), "\n")
@@ -54,9 +53,8 @@
IC.L2 <- IC1 %*% t(L2deriv)
res <- numeric(length(IC.L2))
for(i in 1:length(IC.L2)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC.L2 at Map[[i]])
+ fct <- function(x, cond){ IC.L2 at Map[[i]](cbind(t(cond),x)) }
+ res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct)
}
consist <- matrix(res, nrow = nrow(trafo)) - trafo
if(out){
@@ -90,9 +88,8 @@
IC1 <- as(diag(nrow(trafo)) %*% IC at Curve, "EuclRandVariable")
cent <- array(0, c(length(IC1), length(cond), nrow(trafo)))
for(i in 1:length(IC1)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC1 at Map[[i]])
+ fct <- function(x, cond){ IC1 at Map[[i]](cbind(t(cond),x)) }
+ cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct)
}
if(out)
cat("precision of conditional centering:\t", max(abs(cent)), "\n")
@@ -103,9 +100,8 @@
IC.L2 <- IC1 %*% t(L2deriv)
res <- numeric(length(IC.L2))
for(i in 1:length(IC.L2)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC.L2 at Map[[i]])
+ fct <- function(x, cond) IC.L2 at Map[[i]](cbind(t(cond),x))
+ res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct)
}
consist <- matrix(res, nrow = nrow(trafo)) - trafo
if(out){
Modified: pkg/ROptRegTS/R/Expectation.R
===================================================================
--- pkg/ROptRegTS/R/Expectation.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/Expectation.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -9,12 +9,12 @@
fun = "EuclRandVariable",
cond = "missing"),
function(object, fun){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
-
+# fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
res <- numeric(length(fun))
for(i in 1:length(fun)){
+ fct <- function(x,cond) fun at Map[[i]](cbind(t(cond),x))
res[i] <- E(object at RegDistr, .condE, D1 = object at distribution,
- fct = fct, f1 = fun at Map[[i]])
+ fct = fct)
}
return(res)
Modified: pkg/ROptRegTS/R/L2RegTypeFamily.R
===================================================================
--- pkg/ROptRegTS/R/L2RegTypeFamily.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/L2RegTypeFamily.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -48,10 +48,12 @@
L2.L2 <- L2deriv1 %*% t(L2deriv1)
res <- numeric(length(L2.L2))
for(i in 1:length(L2.L2)){
- fct <- function(x, cond, f1){ f1(cbind(cond,x)) }
- res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct,
- f1 = L2.L2 at Map[[i]])
- }
+ #fct <- function(x, cond, f1){ f1(cbind(cond,x)) }
+ #res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct,
+ # f1 = L2.L2 at Map[[i]])
+ fct <- function(x,cond) L2.L2 at Map[[i]](cbind(cond,x))
+ res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct)
+ }
FisherInfo <- PosDefSymmMatrix(matrix(res, nrow = dims))
}else{
stop("not yet implemented")
Modified: pkg/ROptRegTS/R/getAsRiskRegTS.R
===================================================================
--- pkg/ROptRegTS/R/getAsRiskRegTS.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getAsRiskRegTS.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -19,7 +19,7 @@
if(!is.finite(neighbor at radius))
return(list(asMSE = Inf))
else{
- K.inv <- solve(E(Regressor, fun = function(x){ x %*% t(x) }))
+ K.inv <- distr::solve(E(Regressor, fun = function(x){ x %*% t(x) }))
return(list(asMSE = stand * sum(diag(t(trafo) %*% K.inv))))
}
})
@@ -178,7 +178,7 @@
K <- E(Regressor, fun = function(x){ x %*% t(x) })
z <- q.l(ErrorL2deriv)(0.5)
Eu <- E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z)
- b <- sqrt(sum(diag(trafo %*% solve(K) %*% t(trafo))))/Eu
+ b <- sqrt(sum(diag(trafo %*% distr::solve(K) %*% t(trafo))))/Eu
return(list(asBias = b))
})
Modified: pkg/ROptRegTS/R/getIneffDiff.R
===================================================================
--- pkg/ROptRegTS/R/getIneffDiff.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getIneffDiff.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -90,7 +90,7 @@
trafo = L2Fam at param@trafo, upper = upper.b, maxiter = MaxIter,
tol = eps, warn = warn)
trafo <- L2Fam at param@trafo
- K.inv <- solve(E(L2Fam at RegDistr, fun = function(x){ x %*% t(x) }))
+ K.inv <- distr::solve(E(L2Fam at RegDistr, fun = function(x){ x %*% t(x) }))
ineffLo <- (res$A*sum(diag(t(trafo) %*% K.inv)) - res$b^2*(radius^2-loRad^2))/loRisk
if(upRad == Inf)
ineffUp <- res$b^2/upRisk
Modified: pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R
===================================================================
--- pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -114,7 +114,7 @@
K <- E(Regressor, fun = function(x){ x %*% t(x) })
z <- q.l(ErrorL2deriv)(0.5)
Eu <- E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z)
- b <- sqrt(sum(diag(trafo %*% solve(K) %*% t(trafo))))/Eu
+ b <- sqrt(sum(diag(trafo %*% distr::solve(K) %*% t(trafo))))/Eu
if(is(ErrorL2deriv, "AbscontDistribution")){
ws0 <- 0
Modified: pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R
===================================================================
--- pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -8,7 +8,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- max(abs(as.vector(A)))*max(q.l(ErrorL2deriv)(1),abs(q.l(ErrorL2deriv)(0)))
if(is(Regressor, "UnivariateDistribution"))
b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
@@ -24,7 +24,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- abs(as.vector(A))*(q.l(ErrorL2deriv)(1) - q.l(ErrorL2deriv)(0))
b <- b*(abs(q.l(Regressor)(1)) + abs(q.l(Regressor)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
@@ -38,7 +38,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- max(abs(as.vector(A)))*max(q.l(ErrorL2deriv)(1),abs(q.l(ErrorL2deriv)(0)))
if(is(Regressor, "UnivariateDistribution"))
b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
@@ -57,7 +57,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- abs(as.vector(A))*(q.l(ErrorL2deriv)(1) - q.l(ErrorL2deriv)(0))
if(is(Regressor, "UnivariateDistribution"))
b <- b*(abs(q.l(Regressor)(1)) + abs(q.l(Regressor)(0)))
@@ -80,7 +80,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- max(abs(as.vector(A)))*max(q.l(ErrorL2deriv)(1),abs(q.l(ErrorL2deriv)(0)))
if(is(Regressor, "UnivariateDistribution"))
b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
@@ -100,7 +100,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- max(abs(as.vector(A)))*max(q.l(ErrorL2deriv)(1),abs(q.l(ErrorL2deriv)(0)))
if(is(Regressor, "UnivariateDistribution"))
b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
@@ -115,7 +115,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
b <- max(abs(as.vector(A)))*abs(q.l(ErrorL2deriv)(1) - q.l(ErrorL2deriv)(0))
if(is(Regressor, "UnivariateDistribution"))
b <- b*(q.l(Regressor)(1) - q.l(Regressor)(0))
@@ -132,7 +132,7 @@
neighbor = "ContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorDistr, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
if(is(ErrorDistr, "UnivariateDistribution")){
lower <- ifelse(is.finite(q.l(ErrorDistr)(0)), q.l(ErrorDistr)(1e-8), q.l(ErrorDistr)(0))
@@ -155,7 +155,7 @@
neighbor = "Av1CondContNeighborhood"),
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorDistr, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
- A <- trafo %*% solve(Finfo)
+ A <- trafo %*% distr::solve(Finfo)
if(is(ErrorDistr, "UnivariateDistribution")){
lower <- ifelse(is.finite(q.l(ErrorDistr)(0)), q.l(ErrorDistr)(1e-8), q.l(ErrorDistr)(0))
Modified: pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c2.R
===================================================================
--- pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c2.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c2.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -72,7 +72,7 @@
A <- getInfStandRegTS(ErrorL2deriv = ErrorL2deriv, Regressor = Regressor,
neighbor = neighbor, z.comp = z.comp, clip = c0, cent = z,
stand = A, trafo = trafo)
- b <- c0*A*sqrt(sum(diag(solve(E(Regressor, fun = function(x){ x %*% t(x) })))))
+ b <- c0*A*sqrt(sum(diag(distr::solve(E(Regressor, fun = function(x){ x %*% t(x) })))))
info <- paste("optimally robust IC for", sQuote(class(risk)[1]))
Risk <- getAsRiskRegTS(risk = risk, ErrorL2deriv = ErrorL2deriv,
Modified: pkg/ROptRegTS/R/getInfStandRegTS.R
===================================================================
--- pkg/ROptRegTS/R/getInfStandRegTS.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/getInfStandRegTS.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -92,7 +92,7 @@
res <- E(Regressor, Afct, clip = clip, stand = stand, D1 = ErrorL2deriv)
}
- return(trafo %*% solve(res))
+ return(trafo %*% distr::solve(res))
})
setMethod("getInfStandRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "UnivariateDistribution",
@@ -142,7 +142,7 @@
res <- E(Regressor, Afct, clip = clip, stand = stand, D1 = ErrorL2deriv)
}
- return(trafo %*% solve(res))
+ return(trafo %*% distr::solve(res))
})
setMethod("getInfStandRegTS", signature(ErrorL2deriv = "UnivariateDistribution",
Regressor = "Distribution",
@@ -180,7 +180,7 @@
return((x %*% t(x))*(m2df(D1, cx) - m2df(D1, gx) + gx*m1df(D1, gx) - cx*m1df(D1, cx)))
}
- return(trafo %*% solve(E(Regressor, Afct, cent = cent, clip = clip,
+ return(trafo %*% distr::solve(E(Regressor, Afct, cent = cent, clip = clip,
stand = stand, D1 = ErrorL2deriv)))
})
setMethod("getInfStandRegTS", signature(ErrorL2deriv = "RealRandVariable",
@@ -263,7 +263,7 @@
}
res[col(res) < row(res)] <- res[col(res) > row(res)]
- return(trafo %*% solve(res))
+ return(trafo %*% distr::solve(res))
})
setMethod("getInfStandRegTS", signature(ErrorL2deriv = "RealRandVariable",
Regressor = "Distribution",
@@ -334,5 +334,5 @@
}
res[col(res) < row(res)] <- res[col(res) > row(res)]
- return(trafo %*% solve(res))
+ return(trafo %*% distr::solve(res))
})
Modified: pkg/ROptRegTS/R/leastFavorableRadius.R
===================================================================
--- pkg/ROptRegTS/R/leastFavorableRadius.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/leastFavorableRadius.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -122,7 +122,7 @@
trafo <- L2Fam at param@trafo
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
- loRisk <- sum(diag(solve(L2Fam at FisherInfo)))
+ loRisk <- sum(diag(distr::solve(L2Fam at FisherInfo)))
}else{
neighbor at radius <- loRad
resLo <- getInfRobRegTypeIC(ErrorL2deriv = ErrorL2deriv,
Modified: pkg/ROptRegTS/R/optIC.R
===================================================================
--- pkg/ROptRegTS/R/optIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/optIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -3,7 +3,7 @@
###############################################################################
setMethod("optIC", signature(model = "L2RegTypeFamily", risk = "asCov"),
function(model, risk){
- Curve <- as((model at param@trafo %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
+ Curve <- as((model at param@trafo %*% distr::solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
return(IC(
name = paste("Classical optimal influence curve for", model at name),
CallL2Fam = call("L2RegTypeFamily",
@@ -24,7 +24,7 @@
ErrorL2derivDistrSymm = model at ErrorL2derivDistrSymm,
FisherInfo = model at FisherInfo),
Curve = EuclRandVarList(Curve),
- Risks = list(asCov = model at param@trafo %*% solve(model at FisherInfo) %*% t(model at param@trafo)),
+ Risks = list(asCov = model at param@trafo %*% distr::solve(model at FisherInfo) %*% t(model at param@trafo)),
Infos = matrix(c("optIC", "optimal IC in sense of Cramer-Rao bound"),
ncol = 2, dimnames = list(character(0), c("method", "message")))))
})
Modified: pkg/ROptRegTS/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptRegTS/R/radiusMinimaxIC.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/R/radiusMinimaxIC.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -26,7 +26,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
- loRisk <- sum(diag(solve(L2Fam at FisherInfo)))
+ loRisk <- sum(diag(distr::solve(L2Fam at FisherInfo)))
}else{
neighbor at radius <- loRad
resLo <- getInfRobRegTypeIC(ErrorL2deriv = L2Fam at ErrorL2derivDistr[[1]],
@@ -118,7 +118,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
- loRisk <- sum(diag(solve(L2Fam at FisherInfo)))
+ loRisk <- sum(diag(distr::solve(L2Fam at FisherInfo)))
}else{
neighbor at radius <- loRad
resLo <- getInfRobRegTypeIC(ErrorL2deriv = ErrorL2deriv,
Modified: pkg/ROptRegTS/inst/NEWS
===================================================================
--- pkg/ROptRegTS/inst/NEWS 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/ROptRegTS/inst/NEWS 2019-03-02 16:07:41 UTC (rev 1188)
@@ -7,6 +7,15 @@
to ease updating "depends" information)
#######################################
+version 1.2
+#######################################
+
+under the hood
++ now specified that we want to use distr::solve
++ for compatibility with the new capsulation of E()-arguments, we removed additional
+ functional arguments f1 from calls to E() and replaced them by the actual maps
+
+#######################################
version 1.1
#######################################
Modified: pkg/RobRex/DESCRIPTION
===================================================================
--- pkg/RobRex/DESCRIPTION 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/RobRex/DESCRIPTION 2019-03-02 16:07:41 UTC (rev 1188)
@@ -1,12 +1,12 @@
Package: RobRex
-Version: 1.1.0
-Date: 2018-08-01
+Version: 1.2.0
+Date: 2019-03-01
Title: Optimally Robust Influence Curves for Regression and Scale
Description: Functions for the determination of optimally robust influence curves in case of
linear regression with unknown scale and standard normal distributed errors where the
regressor is random.
Depends: R (>= 2.14.0), ROptRegTS(>= 1.1.0)
-Imports: distr(>= 2.7.0), RandVar(>= 1.1.0), RobAStBase(>= 1.1.0), methods
+Imports: distr(>= 2.8.0), RandVar(>= 1.1.0), RobAStBase(>= 1.2.0), methods
Authors at R: person("Matthias", "Kohl", role=c("aut", "cre", "cph"),
email="Matthias.Kohl at stamats.de")
ByteCompile: yes
@@ -15,4 +15,4 @@
URL: http://robast.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1081
+VCS/SVNRevision: 1178
Modified: pkg/RobRex/R/rgsOptIC_AL.R
===================================================================
--- pkg/RobRex/R/rgsOptIC_AL.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/RobRex/R/rgsOptIC_AL.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -92,7 +92,7 @@
.ALrgsGetAz <- function(K, b, A.rg, z.sc, A.sc){
A.rg1 <- E(K, .ALrgsGetArg, b = b, A.rg = A.rg,
z.sc = z.sc, A.sc = A.sc)
- A.rg <- solve(A.rg1)
+ A.rg <- distr::solve(A.rg1)
A.sc1 <- E(K, .ALrgsGetAsc, b = b, A.rg = A.rg,
z.sc = z.sc, A.sc = A.sc)
@@ -139,7 +139,7 @@
A.sc <- A.sc.start; z.sc <- a.sc.start/A.sc + 1
if(missing(A.rg.start))
- A.rg <- solve(Reg2Mom)
+ A.rg <- distr::solve(Reg2Mom)
else
A.rg <- A.rg.start
Modified: pkg/RobRex/R/rgsOptIC_ALc.R
===================================================================
--- pkg/RobRex/R/rgsOptIC_ALc.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/RobRex/R/rgsOptIC_ALc.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -88,7 +88,7 @@
for(i in 1:nrow(supp)){
summe <- summe + prob[i]*supp[i,]%*%t(supp[i,])*A.rg1[i]
}
- A.rg <- solve(summe)
+ A.rg <- distr::solve(summe)
A.sc1 <- apply(z.sc.x, 1, .ALcrgsGetAsc, b = b, A.rg = A.rg, A.sc = A.sc)
A.sc <- 1/sum(prob*A.sc1)
@@ -141,7 +141,7 @@
else
z.sc <- a.sc.start/A.sc + 1
if(missing(A.rg.start))
- A.rg <- solve(Reg2Mom)
+ A.rg <- distr::solve(Reg2Mom)
else
A.rg <- A.rg.start
@@ -209,14 +209,14 @@
body(fct1) <- substitute({ numeric(k) }, list(k = k))
if(is(K, "DiscreteMVDistribution")){
fct2 <- function(x){
- if(liesInSupport(K, x[1:k])){
+ if(liesInSupport(K, x[1:k], checkFin = TRUE)){
ind <- colSums(apply(supp, 1, "==", x[1:k])) == k
return(a.sc[ind])
}else{
return(NA)
}
}
- body(fct2) <- substitute({ if(liesInSupport(K, x[1:k])){
+ body(fct2) <- substitute({ if(liesInSupport(K, x[1:k], checkFin = TRUE)){
ind <- colSums(apply(supp, 1, "==", x[1:k])) == k
return(a.sc[ind])
}else{
@@ -225,7 +225,7 @@
}
if(is(K, "DiscreteDistribution")){
fct2 <- function(x){
- if(liesInSupport(K, x[1])){
+ if(liesInSupport(K, x[1], checkFin = TRUE)){
ind <- (round(x[1], 8) == round(supp, 8))
return(a.sc[ind])
}else{
Modified: pkg/RobRex/R/rgsOptIC_ALs.R
===================================================================
--- pkg/RobRex/R/rgsOptIC_ALs.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/RobRex/R/rgsOptIC_ALs.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -76,7 +76,7 @@
.ALsrgsGetArg <- function(K, b.rg, A.rg){
A.rg1 <- E(K, .ALsrgsGetArg1, b.rg = b.rg, A.rg = A.rg)
- return(solve(A.rg1))
+ return(distr::solve(A.rg1))
}
@@ -104,7 +104,7 @@
"is (numerically) not positive definite")
if(missing(A.rg.start))
- A.rg <- solve(Reg2Mom)
+ A.rg <- distr::solve(Reg2Mom)
else
A.rg <- A.rg.start
@@ -166,8 +166,8 @@
cat("MSE equation for eta.sc:\t", rvgl.sc, "\n")
}
- k <- dimension(img(K))
- vec.A <- as.vector(A.rg)
+ k <- dimension(img(K))
+ vec.A <- as.vector(A.rg)
w <- .ALsrgsGetwrg
fct1 <- function(x){
A.rg <- matrix(vec.A, ncol = k)
Modified: pkg/RobRex/R/rgsOptIC_M.R
===================================================================
--- pkg/RobRex/R/rgsOptIC_M.R 2019-03-02 16:07:01 UTC (rev 1187)
+++ pkg/RobRex/R/rgsOptIC_M.R 2019-03-02 16:07:41 UTC (rev 1188)
@@ -243,10 +243,10 @@
k <- dimension(img(K))
Gk <- .duplicationMatrix(dimn = k)
- Hk <- solve(t(Gk) %*% Gk)%*%t(Gk)
+ Hk <- distr::solve(t(Gk) %*% Gk)%*%t(Gk)
h5 <- Hk %*% h5 %*% Gk
- vech.B <- solve(h5) %*% vech.D
+ vech.B <- distr::solve(h5) %*% vech.D
B <- matrix(0, nrow = k , ncol = k)
B[row(B) >= col(B)] <- vech.B
B[row(B) < col(B)] <- B[row(B) > col(B)]
@@ -305,7 +305,7 @@
###############################################################################
.MrgsGetba1a3B <- function(r, K, A, gg, a1, a3, B, bUp, delta, itmax){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 1188
More information about the Robast-commits
mailing list