[Robast-commits] r957 - in branches/robast-1.1/pkg/ROptEstOld: . R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 17 10:13:37 CEST 2018
Author: ruckdeschel
Date: 2018-07-17 10:13:37 +0200 (Tue, 17 Jul 2018)
New Revision: 957
Modified:
branches/robast-1.1/pkg/ROptEstOld/DESCRIPTION
branches/robast-1.1/pkg/ROptEstOld/R/AllPlot.R
branches/robast-1.1/pkg/ROptEstOld/R/getAsRisk.R
branches/robast-1.1/pkg/ROptEstOld/R/getInfCent.R
branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asBias.R
branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asCov.R
branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asHampel.R
branches/robast-1.1/pkg/ROptEstOld/R/infoPlot.R
branches/robast-1.1/pkg/ROptEstOld/R/lowerCaseRadius.R
branches/robast-1.1/pkg/ROptEstOld/inst/NEWS
Log:
[ROptEstOld] branch 1.1 + wherever possible also use q.l internally instead of q to
provide functionality in IRKernel
Modified: branches/robast-1.1/pkg/ROptEstOld/DESCRIPTION
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/DESCRIPTION 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/DESCRIPTION 2018-07-17 08:13:37 UTC (rev 957)
@@ -1,6 +1,6 @@
Package: ROptEstOld
-Version: 1.0
-Date: 2015-05-03
+Version: 1.1.0
+Date: 2018-07-17
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.
@@ -12,4 +12,4 @@
Encoding: latin1
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: -Inf
+SVNRevision: 940
Modified: branches/robast-1.1/pkg/ROptEstOld/R/AllPlot.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/AllPlot.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/AllPlot.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -13,8 +13,8 @@
plot(e1)
if(is(e1, "AbscontDistribution")){
- lower <- ifelse(is.finite(q(e1)(0)), q(e1)(0), q(e1)(getdistrOption("TruncQuantile")))
- upper <- ifelse(is.finite(q(e1)(1)), q(e1)(1), q(e1)(1 - getdistrOption("TruncQuantile")))
+ lower <- ifelse(is.finite(q.l(e1)(0)), q.l(e1)(0), q.l(e1)(getdistrOption("TruncQuantile")))
+ upper <- ifelse(is.finite(q.l(e1)(1)), q.l(e1)(1), q.l(e1)(1 - getdistrOption("TruncQuantile")))
h <- upper - lower
x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
plty <- "l"
@@ -69,8 +69,8 @@
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
if(is(e1, "AbscontDistribution")){
- lower <- ifelse(is.finite(q(e1)(0)), q(e1)(0), q(e1)(getdistrOption("TruncQuantile")))
- upper <- ifelse(is.finite(q(e1)(1)), q(e1)(1), q(e1)(1 - getdistrOption("TruncQuantile")))
+ lower <- ifelse(is.finite(q.l(e1)(0)), q.l(e1)(0), q.l(e1)(getdistrOption("TruncQuantile")))
+ upper <- ifelse(is.finite(q.l(e1)(1)), q.l(e1)(1), q.l(e1)(1 - getdistrOption("TruncQuantile")))
h <- upper - lower
x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
plty <- "l"
Modified: branches/robast-1.1/pkg/ROptEstOld/R/getAsRisk.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/getAsRisk.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/getAsRisk.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -29,7 +29,7 @@
L2deriv = "UnivariateDistribution",
neighbor = "ContNeighborhood"),
function(risk, L2deriv, neighbor, trafo){
- z <- q(L2deriv)(0.5)
+ z <- q.l(L2deriv)(0.5)
bias <- abs(as.vector(trafo))/E(L2deriv, function(x, z){abs(x - z)},
useApply = FALSE, z = z)
Modified: branches/robast-1.1/pkg/ROptEstOld/R/getInfCent.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/getInfCent.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/getInfCent.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -9,8 +9,8 @@
z.fct <- function(z, c0, D1){
return(c0 + (z-c0)*p(D1)(z-c0) - (z+c0)*p(D1)(z+c0) + m1df(D1, z+c0) - m1df(D1, z-c0))
}
- lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
- upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
+ lower <- q.l(L2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(L2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
c0=clip, D1=L2deriv)$root)
@@ -24,8 +24,8 @@
g.fct <- function(g, c0, D1){
return(g*p(D1)(g) + (g+c0)*(1-p(D1)(g+c0)) - m1df(D1, g) + m1df(D1, g+c0))
}
- lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
- upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
+ lower <- q.l(L2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(L2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = D1)$root)
Modified: branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asBias.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asBias.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asBias.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -8,7 +8,7 @@
upper, maxiter, tol, warn){
zi <- sign(as.vector(trafo))
A <- as.matrix(zi)
- z <- q(L2deriv)(0.5)
+ z <- q.l(L2deriv)(0.5)
b <- zi*as.vector(trafo)/E(L2deriv, function(x, z){abs(x - z)}, z = z)
if(is(L2deriv, "AbscontDistribution"))
Modified: branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asCov.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asCov.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asCov.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -7,7 +7,7 @@
function(L2deriv, risk, neighbor, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- abs(as.vector(A))*max(abs(q(L2deriv)(1)),abs(q(L2deriv)(0)))
+ b <- abs(as.vector(A))*max(abs(q.l(L2deriv)(1)),abs(q.l(L2deriv)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
return(list(A = A, a = 0, b = b, d = NULL, risk = Risk, info = info))
@@ -18,7 +18,7 @@
function(L2deriv, risk, neighbor, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- abs(as.vector(A))*(q(L2deriv)(1)-q(L2deriv)(0))
+ b <- abs(as.vector(A))*(q.l(L2deriv)(1)-q.l(L2deriv)(0))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
return(list(A = A, a = -b/2, b = b, d = NULL, risk = Risk, info = info))
@@ -31,8 +31,8 @@
A <- trafo %*% solve(Finfo)
IC <- A %*% L2deriv
if(is(Distr, "UnivariateDistribution")){
- lower <- ifelse(is.finite(q(Distr)(0)), q(Distr)(1e-8), q(Distr)(0))
- upper <- ifelse(is.finite(q(Distr)(1)), q(Distr)(1-1e-8), q(Distr)(1))
+ lower <- ifelse(is.finite(q.l(Distr)(0)), q.l(Distr)(1e-8), q.l(Distr)(0))
+ upper <- ifelse(is.finite(q.l(Distr)(1)), q.l(Distr)(1-1e-8), q.l(Distr)(1))
x <- seq(from = lower, to = upper, length = 1e5)
x <- x[x!=0] # problems with NaN=log(0)!
b <- evalRandVar(IC, as.matrix(x))^2
Modified: branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asHampel.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asHampel.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/getInfRobIC_asHampel.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -8,7 +8,7 @@
upper, maxiter, tol, warn){
A <- trafo / E(L2deriv, function(x){x^2})
b <- risk at bound
- bmax <- abs(as.vector(A))*max(abs(q(L2deriv)(0)), q(L2deriv)(1))
+ bmax <- abs(as.vector(A))*max(abs(q.l(L2deriv)(0)), q.l(L2deriv)(1))
if(b >= bmax){
if(warn) cat("'b >= maximum asymptotic bias' => (classical) optimal IC\n",
"in sense of Cramer-Rao bound is returned\n")
@@ -70,8 +70,8 @@
if(is.null(A.start)) A.start <- trafo
ClassIC <- trafo %*% solve(Finfo) %*% L2deriv
- lower <- q(Distr)(getdistrOption("TruncQuantile"))
- upper <- q(Distr)(1-getdistrOption("TruncQuantile"))
+ lower <- q.l(Distr)(getdistrOption("TruncQuantile"))
+ upper <- q.l(Distr)(1-getdistrOption("TruncQuantile"))
x <- seq(from = lower, to = upper, by = 0.01)
bmax <- evalRandVar(ClassIC, as.matrix(x))^2
bmax <- sqrt(max(colSums(bmax)))
Modified: branches/robast-1.1/pkg/ROptEstOld/R/infoPlot.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/infoPlot.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/infoPlot.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -7,8 +7,8 @@
if(is(e1, "UnivariateDistribution")){
if(is(e1, "AbscontDistribution")){
- ifelse(is.finite(q(e1)(0)), lower <- q(e1)(0), lower <- q(e1)(getdistrOption("TruncQuantile")))
- ifelse(is.finite(q(e1)(1)), upper <- q(e1)(1), upper <- q(e1)(1 - getdistrOption("TruncQuantile")))
+ ifelse(is.finite(q.l(e1)(0)), lower <- q.l(e1)(0), lower <- q.l(e1)(getdistrOption("TruncQuantile")))
+ ifelse(is.finite(q.l(e1)(1)), upper <- q.l(e1)(1), upper <- q.l(e1)(1 - getdistrOption("TruncQuantile")))
h <- upper - lower
x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
plty <- "l"
Modified: branches/robast-1.1/pkg/ROptEstOld/R/lowerCaseRadius.R
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/R/lowerCaseRadius.R 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/R/lowerCaseRadius.R 2018-07-17 08:13:37 UTC (rev 957)
@@ -13,7 +13,7 @@
w0 <- options("warn")
options(warn = -1)
L2deriv <- L2Fam at L2derivDistr[[1]]
- m <- q(L2deriv)(0.5)
+ m <- q.l(L2deriv)(0.5)
wsm <- d(L2deriv)(m)
supp <- support(L2deriv)
Modified: branches/robast-1.1/pkg/ROptEstOld/inst/NEWS
===================================================================
--- branches/robast-1.1/pkg/ROptEstOld/inst/NEWS 2018-07-17 08:10:28 UTC (rev 956)
+++ branches/robast-1.1/pkg/ROptEstOld/inst/NEWS 2018-07-17 08:13:37 UTC (rev 957)
@@ -8,6 +8,14 @@
information)
#######################################
+version 1.1
+#######################################
+
+under the hood:
++ wherever possible also use q.l internally instead of q to
+ provide functionality in IRKernel
+
+#######################################
version 1.0
#######################################
More information about the Robast-commits
mailing list