[Robast-commits] r958 - in branches/robast-1.1/pkg/ROptRegTS: . R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 17 10:16:08 CEST 2018
Author: ruckdeschel
Date: 2018-07-17 10:16:08 +0200 (Tue, 17 Jul 2018)
New Revision: 958
Modified:
branches/robast-1.1/pkg/ROptRegTS/DESCRIPTION
branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R
branches/robast-1.1/pkg/ROptRegTS/R/CondIC.R
branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R
branches/robast-1.1/pkg/ROptRegTS/R/getFiRiskRegTS.R
branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R
branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R
branches/robast-1.1/pkg/ROptRegTS/inst/NEWS
Log:
[ROptRegTS] branch 1.1 + wherever possible also use q.l internally instead of q to
provide functionality in IRKernel
Modified: branches/robast-1.1/pkg/ROptRegTS/DESCRIPTION
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/DESCRIPTION 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/DESCRIPTION 2018-07-17 08:16:08 UTC (rev 958)
@@ -1,17 +1,18 @@
Package: ROptRegTS
-Version: 1.0
-Date: 2015-05-03
+Version: 1.1.0
+Date: 2018-07-08
Title: Optimally Robust Estimation for Regression-Type Models
Description: Optimally robust estimation for regression-type models using S4 classes and
methods.
-Depends: R (>= 2.14.0), methods, ROptEstOld(>= 0.9.1)
+Depends: R (>= 2.14.0), methods, ROptEstOld(>= 0.9.1)
Imports: distr(>= 2.5.2), distrEx(>= 2.5), RandVar(>= 0.9.2)
-Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph"), email="Matthias.Kohl at stamats.de"),
- person("Peter", "Ruckdeschel", role=c("aut", "cph")))
+Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph"),
+ email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel", role=c("aut",
+ "cph")))
ByteCompile: yes
License: LGPL-3
Encoding: latin1
URL: http://robast.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: -Inf
+SVNRevision: 940
Modified: branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -160,8 +160,8 @@
radCurve <- object at neighbor@radiusCurve
if(is(D1, "UnivariateDistribution")){
if(is(D1, "AbscontDistribution")){
- xlo <- ifelse(is.finite(q(D1)(0)), q(D1)(0), q(D1)(distr::TruncQuantile))
- xup <- ifelse(is.finite(q(D1)(1)), q(D1)(1), q(D1)(1 - distr::TruncQuantile))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(distr::TruncQuantile))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - distr::TruncQuantile))
x <- seq(from = xlo, to = xup, by = 1e-3)
}else{
if(is(Regressor, "DiscreteDistribution"))
@@ -210,8 +210,8 @@
radCurve <- object at neighbor@radiusCurve
if(is(D1, "UnivariateDistribution")){
if(is(D1, "AbscontDistribution")){
- xlo <- ifelse(is.finite(q(D1)(0)), q(D1)(0), q(D1)(distr::TruncQuantile))
- xup <- ifelse(is.finite(q(D1)(1)), q(D1)(1), q(D1)(1 - distr::TruncQuantile))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(distr::TruncQuantile))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - distr::TruncQuantile))
x <- seq(from = xlo, to = xup, by = 1e-3)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/CondIC.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/CondIC.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/CondIC.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -30,7 +30,7 @@
cond <- as.matrix(support(K))
else{
if(is(K, "AbscontDistribution"))
- cond <- as.matrix(seq(from = q(K)(TruncQuantile), to = q(K)(1-TruncQuantile),
+ cond <- as.matrix(seq(from = q.l(K)(TruncQuantile), to = q.l(K)(1-TruncQuantile),
length = 100))
else
cond <- as.matrix(r(K)(1000))
@@ -78,7 +78,7 @@
cond <- as.matrix(support(K))
else{
if(is(K, "AbscontDistribution"))
- cond <- as.matrix(seq(from = q(K)(TruncQuantile), to = q(K)(1-TruncQuantile),
+ cond <- as.matrix(seq(from = q.l(K)(TruncQuantile), to = q.l(K)(1-TruncQuantile),
length = 100))
else
cond <- as.matrix(r(K)(1000))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -74,7 +74,7 @@
ErrorL2derivDistrSymm, trafo, maxiter, tol){
zi <- sign(as.vector(trafo))
A <- as.matrix(zi)
- z <- q(ErrorL2deriv)(0.5)
+ z <- q.l(ErrorL2deriv)(0.5)
Eu <- E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z)
Ex <- E(Regressor, function(x){abs(x)})
b <- zi*as.vector(trafo)/(Ex*Eu)
@@ -163,7 +163,7 @@
erg <- optim(as.vector(trafo), bmin.fct, method = "Nelder-Mead",
control = list(reltol = tol, maxit = 100*maxiter),
Regressor = Regressor, trafo = trafo)
- z <- q(ErrorL2deriv)(0.5)
+ z <- q.l(ErrorL2deriv)(0.5)
b <- 1/(erg$value*E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z))
return(list(asBias = b))
@@ -175,7 +175,7 @@
function(risk, ErrorL2deriv, Regressor, neighbor,
ErrorL2derivDistrSymm, trafo, maxiter, tol){
K <- E(Regressor, fun = function(x){ x %*% t(x) })
- z <- q(ErrorL2deriv)(0.5)
+ 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
@@ -281,8 +281,8 @@
neighbor = "CondNeighborhood"),
function(risk, ErrorL2deriv, Regressor, neighbor, clip, cent, stand){
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, by = 0.01)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getFiRiskRegTS.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getFiRiskRegTS.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getFiRiskRegTS.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -292,8 +292,8 @@
m <- distr::DefaultNrFFTGridPointsExponent
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
@@ -366,8 +366,8 @@
m <- distr::DefaultNrFFTGridPointsExponent
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -53,8 +53,8 @@
tol, warn, Algo, cont){
radiusCurve <- neighbor at radiusCurve
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
@@ -100,11 +100,11 @@
return(NA)
}
}else{
- if(is.finite(q(Regressor)(0)))
+ if(is.finite(q.l(Regressor)(0)))
yleft <- NA
else
yleft <- b[1]
- if(is.finite(q(Regressor)(1)))
+ if(is.finite(q.l(Regressor)(1)))
yright <- NA
else
yright <- b.vec[length(b.vec)]
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -39,8 +39,8 @@
}
return(E(K, gu.fct, z = z, c0 = c0, D1 = D1))
}
- lower <- q(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
+ upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = D1, K = Regressor)$root)
@@ -94,8 +94,8 @@
z*(1-p(D1)(z/x)) + x*(m1df(D1, z/x) - m1df(D1, b/x)) + b*p(D1)(b/x)
}
}
- lower <- q(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
+ upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = D1, x = Regressor)$root)
@@ -130,11 +130,11 @@
return(NA)
}
}else{
- if(is.finite(q(Regressor)(0)))
+ if(is.finite(q.l(Regressor)(0)))
yleft <- NA
else
yleft <- z.vec[1]
- if(is.finite(q(Regressor)(1)))
+ if(is.finite(q.l(Regressor)(1)))
yright <- NA
else
yright <- z.vec[length(z.vec)]
@@ -203,8 +203,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(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
+ upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
c0=clip, D1=ErrorL2deriv)$root)
@@ -228,8 +228,8 @@
zfun <- function(x, z0, c0, D1, tol.z){
if(x == 0) return(0)
- lower <- q(D1)(distr::TruncQuantile)
- upper <- q(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(distr::TruncQuantile)
+ upper <- q.l(D1)(1-distr::TruncQuantile)
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = c0, xx = x, D1 = D1)$root)
@@ -245,11 +245,11 @@
return(NA)
}
}else{
- if(is.finite(q(Regressor)(0)))
+ if(is.finite(q.l(Regressor)(0)))
yleft <- NA
else
yleft <- z.vec[1]
- if(is.finite(q(Regressor)(1)))
+ if(is.finite(q.l(Regressor)(1)))
yright <- NA
else
yright <- z.vec[length(z.vec)]
@@ -278,8 +278,8 @@
zfun <- function(x, z0, c0, A0, D1, tol.z){
if(all(x == numeric(length(x)))) return(0)
- lower <- q(D1)(distr::TruncQuantile)
- upper <- q(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(distr::TruncQuantile)
+ upper <- q.l(D1)(1-distr::TruncQuantile)
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = c0, A0 = A0, xx = x, D1 = D1)$root)
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asBias.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -76,7 +76,7 @@
RegSymm, Finfo, trafo, upper, maxiter, tol, warn){
zi <- sign(as.vector(trafo))
A <- as.matrix(zi)
- z <- q(ErrorL2deriv)(0.5)
+ z <- q.l(ErrorL2deriv)(0.5)
Eu <- E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z)
Ex <- E(Regressor, abs)
b <- zi*as.vector(trafo)/(Ex*Eu)
@@ -112,7 +112,7 @@
function(ErrorL2deriv, Regressor, risk, neighbor, ErrorL2derivDistrSymm,
RegSymm, Finfo, trafo, upper, maxiter, tol, warn){
K <- E(Regressor, fun = function(x){ x %*% t(x) })
- z <- q(ErrorL2deriv)(0.5)
+ 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
@@ -251,7 +251,7 @@
erg <- optim(as.vector(trafo), bmin.fct, method = "Nelder-Mead",
control=list(reltol=tol, maxit=100*maxiter), Regressor = Regressor, trafo = trafo)
- z <- q(ErrorL2deriv)(0.5)
+ z <- q.l(ErrorL2deriv)(0.5)
b <- 1/(erg$value*E(ErrorL2deriv, function(x, z){abs(x - z)}, z = z))
p <- nrow(trafo)
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asCov.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -9,9 +9,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- max(abs(as.vector(A)))*max(q(ErrorL2deriv)(1),abs(q(ErrorL2deriv)(0)))
+ 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(Regressor)(1)), abs(q(Regressor)(0)))
+ b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
@@ -25,8 +25,8 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- abs(as.vector(A))*(q(ErrorL2deriv)(1) - q(ErrorL2deriv)(0))
- b <- b*(abs(q(Regressor)(1)) + abs(q(Regressor)(0)))
+ 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)
return(list(A = A, a = -b/2, b = b, d = NULL, risk = Risk, info = info))
@@ -39,9 +39,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- max(abs(as.vector(A)))*max(q(ErrorL2deriv)(1),abs(q(ErrorL2deriv)(0)))
+ 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(Regressor)(1)), abs(q(Regressor)(0)))
+ b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
b.fct <- function(x){ b }
body(b.fct) <- substitute({ b }, list(b = b))
bfun <- RealRandVariable(Map = list(b.fct),
@@ -58,9 +58,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- abs(as.vector(A))*(q(ErrorL2deriv)(1) - q(ErrorL2deriv)(0))
+ b <- abs(as.vector(A))*(q.l(ErrorL2deriv)(1) - q.l(ErrorL2deriv)(0))
if(is(Regressor, "UnivariateDistribution"))
- b <- b*(abs(q(Regressor)(1)) + abs(q(Regressor)(0)))
+ b <- b*(abs(q.l(Regressor)(1)) + abs(q.l(Regressor)(0)))
b.fct <- function(x){ b }
body(b.fct) <- substitute({ b }, list(b = b))
bfun <- RealRandVariable(Map = list(b.fct),
@@ -81,9 +81,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- max(abs(as.vector(A)))*max(q(ErrorL2deriv)(1),abs(q(ErrorL2deriv)(0)))
+ 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(Regressor)(1)), abs(q(Regressor)(0)))
+ b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
a.fct <- function(x){numeric(k)}
body(a.fct) <- substitute({numeric(k)}, list(k = nrow(trafo)))
@@ -101,9 +101,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- max(abs(as.vector(A)))*max(q(ErrorL2deriv)(1),abs(q(ErrorL2deriv)(0)))
+ 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(Regressor)(1)), abs(q(Regressor)(0)))
+ b <- b*max(abs(q.l(Regressor)(1)), abs(q.l(Regressor)(0)))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
return(list(A = 1, z = 0, b = b, d = NULL, risk = Risk, info = info))
@@ -116,9 +116,9 @@
RegSymm, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
- b <- max(abs(as.vector(A)))*abs(q(ErrorL2deriv)(1) - q(ErrorL2deriv)(0))
+ b <- max(abs(as.vector(A)))*abs(q.l(ErrorL2deriv)(1) - q.l(ErrorL2deriv)(0))
if(is(Regressor, "UnivariateDistribution"))
- b <- b*(q(Regressor)(1) - q(Regressor)(0))
+ b <- b*(q.l(Regressor)(1) - q.l(Regressor)(0))
Risk <- list(asCov = A %*% t(trafo), asBias = b)
a.fct <- function(x){-b/2}
body(a.fct) <- substitute({-b/2}, list(b = b))
@@ -135,8 +135,8 @@
A <- trafo %*% solve(Finfo)
if(is(ErrorDistr, "UnivariateDistribution")){
- lower <- ifelse(is.finite(q(ErrorDistr)(0)), q(ErrorDistr)(1e-8), q(ErrorDistr)(0))
- upper <- ifelse(is.finite(q(ErrorDistr)(1)), q(ErrorDistr)(1-1e-8), q(ErrorDistr)(1))
+ lower <- ifelse(is.finite(q.l(ErrorDistr)(0)), q.l(ErrorDistr)(1e-8), q.l(ErrorDistr)(0))
+ upper <- ifelse(is.finite(q.l(ErrorDistr)(1)), q.l(ErrorDistr)(1-1e-8), q.l(ErrorDistr)(1))
x <- seq(from = lower, to = upper, length = 1e4)
x <- x[x!=0] # problems with NaN=log(0)!
b <- evalRandVar(ErrorL2deriv, as.matrix(x))^2
@@ -158,8 +158,8 @@
A <- trafo %*% solve(Finfo)
if(is(ErrorDistr, "UnivariateDistribution")){
- lower <- ifelse(is.finite(q(ErrorDistr)(0)), q(ErrorDistr)(1e-8), q(ErrorDistr)(0))
- upper <- ifelse(is.finite(q(ErrorDistr)(1)), q(ErrorDistr)(1-1e-8), q(ErrorDistr)(1))
+ lower <- ifelse(is.finite(q.l(ErrorDistr)(0)), q.l(ErrorDistr)(1e-8), q.l(ErrorDistr)(0))
+ upper <- ifelse(is.finite(q.l(ErrorDistr)(1)), q.l(ErrorDistr)(1-1e-8), q.l(ErrorDistr)(1))
x <- seq(from = lower, to = upper, length = 1e4)
x <- x[x!=0] # problems with NaN=log(0)!
b <- evalRandVar(ErrorL2deriv, as.matrix(x))^2
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -33,8 +33,8 @@
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
@@ -150,8 +150,8 @@
z <- z.start
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -33,8 +33,8 @@
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R 2018-07-17 08:16:08 UTC (rev 958)
@@ -152,8 +152,8 @@
RegSymm, Finfo, trafo, upper, maxiter, tol, warn){
radiusCurve <- neighbor at radiusCurve
if(is(Regressor, "AbscontDistribution")){
- xlower <- ifelse(is.finite(q(Regressor)(0)), q(Regressor)(0), q(Regressor)(distr::TruncQuantile))
- xupper <- ifelse(is.finite(q(Regressor)(1)), q(Regressor)(1), q(Regressor)(1 - distr::TruncQuantile))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(distr::TruncQuantile))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - distr::TruncQuantile))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
@@ -257,14 +257,14 @@
return(NA)
}
}else{
- if(is.finite(q(Regressor)(0))){
+ if(is.finite(q.l(Regressor)(0))){
yleft.b <- NA
yleft.z <- NA
}else{
yleft.b <- b.vec[1]
yleft.z <- z.vec[1]
}
- if(is.finite(q(Regressor)(1))){
+ if(is.finite(q.l(Regressor)(1))){
yright.b <- NA
yright.z <- NA
}else{
Modified: branches/robast-1.1/pkg/ROptRegTS/inst/NEWS
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/inst/NEWS 2018-07-17 08:13:37 UTC (rev 957)
+++ branches/robast-1.1/pkg/ROptRegTS/inst/NEWS 2018-07-17 08:16:08 UTC (rev 958)
@@ -2,12 +2,19 @@
## News: to package ROptRegTS
###############################################################################
-(first two numbers of package versions do not necessarily reflect
- package-individual development, but rather are chosen for the
- RobAStXXX family as a whole in order to ease updating "depends"
- information)
+(first two numbers of package versions do not necessarily reflect package-individual
+ development, but rather are chosen for the RobAStXXX family as a whole in order
+ to ease updating "depends" 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
#######################################
@@ -25,8 +32,8 @@
#######################################
no changes this time
-+ DESCRIPTION files and package-help files gain a tag SVNRevision
- to be filled by get[All]RevNr.R from utils in distr
++ DESCRIPTION files and package-help files gain a tag SVNRevision to be filled by
+ get[All]RevNr.R from utils in distr
#######################################
version 0.7
@@ -65,4 +72,4 @@
+ use of on.exit() to restore old settings for options() and par() at the end
of functions
+ introduction of NEWS-file
-+ update of CITATION-file (based on code provided by A. Zeileis on R help)
\ No newline at end of file
++ update of CITATION-file (based on code provided by A. Zeileis on R help)
More information about the Robast-commits
mailing list