[Robast-commits] r1055 - branches/robast-1.1/pkg/ROptRegTS/R branches/robast-1.1/pkg/ROptRegTS/inst branches/robast-1.1/pkg/ROptRegTS/inst/scripts branches/robast-1.2/pkg/ROptRegTS/R branches/robast-1.2/pkg/ROptRegTS/inst branches/robast-1.2/pkg/ROptRegTS/inst/scripts pkg/ROptRegTS/R pkg/ROptRegTS/inst pkg/ROptRegTS/inst/scripts
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 25 00:18:12 CEST 2018
Author: ruckdeschel
Date: 2018-07-25 00:18:11 +0200 (Wed, 25 Jul 2018)
New Revision: 1055
Modified:
branches/robast-1.1/pkg/ROptRegTS/R/AllClass.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_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
branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R
branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegScale.R
branches/robast-1.1/pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R
branches/robast-1.2/pkg/ROptRegTS/R/AllClass.R
branches/robast-1.2/pkg/ROptRegTS/R/getAsRiskRegTS.R
branches/robast-1.2/pkg/ROptRegTS/R/getFiRiskRegTS.R
branches/robast-1.2/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
branches/robast-1.2/pkg/ROptRegTS/R/getInfCentRegTS.R
branches/robast-1.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R
branches/robast-1.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R
branches/robast-1.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R
branches/robast-1.2/pkg/ROptRegTS/inst/NEWS
branches/robast-1.2/pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R
branches/robast-1.2/pkg/ROptRegTS/inst/scripts/NormLinRegScale.R
branches/robast-1.2/pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R
pkg/ROptRegTS/R/AllClass.R
pkg/ROptRegTS/R/getAsRiskRegTS.R
pkg/ROptRegTS/R/getFiRiskRegTS.R
pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
pkg/ROptRegTS/R/getInfCentRegTS.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R
pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R
pkg/ROptRegTS/inst/NEWS
pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R
pkg/ROptRegTS/inst/scripts/NormLinRegScale.R
pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R
Log:
[ROptRegT]
+ fixed some issues in scripts and in code --
+ mainly: replaced distr::<object> by getdistrOption("<obj>") resp. distr[Ex]options("<obj>", val) by distr[Ex]options("<obj>"= val)
+ a centering K3-E(K3) was needed to be allowed as error distribution
+ due to package clash distrMod/ROptEst and ROptEstOld call RobRex methods by RobRex:: and do not load the NAMESPACE
Modified: branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/AllClass.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -160,8 +160,8 @@
radCurve <- object at neighbor@radiusCurve
if(is(D1, "UnivariateDistribution")){
if(is(D1, "AbscontDistribution")){
- 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))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(getdistrOption("TruncQuantile")))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - getdistrOption("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.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))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(getdistrOption("TruncQuantile")))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - getdistrOption("TruncQuantile")))
x <- seq(from = xlo, to = xup, by = 1e-3)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -282,8 +282,8 @@
neighbor = "CondNeighborhood"),
function(risk, ErrorL2deriv, Regressor, neighbor, clip, cent, stand){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("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-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getFiRiskRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -62,7 +62,7 @@
eps <- neighbor at radius
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(Algo != "A"){
if(cont == "left"){
@@ -173,7 +173,7 @@
delta <- neighbor at radius
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(Algo != "A"){
if(cont == "left"){
@@ -289,17 +289,17 @@
eps <- neighbor at radiusCurve
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
b.vec <- sapply(x.vec, clip)
@@ -363,17 +363,17 @@
delta <- neighbor at radiusCurve
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
b.vec <- sapply(x.vec, clip)
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -53,14 +53,14 @@
tol, warn, Algo, cont){
radiusCurve <- neighbor at radiusCurve
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
radCx <- radiusCurve(x.vec)
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -40,8 +40,8 @@
}
return(E(K, gu.fct, z = z, c0 = c0, D1 = D1))
}
- lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = ErrorL2deriv, K = Regressor)$root)
@@ -100,8 +100,8 @@
z*(1-p(D1)(z/x)) + x*(m1df(D1, z/x) - m1df(D1, b/x)) + b*p(D1)(b/x)
}
}
- lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = ErrorL2deriv, x = Regressor)$root)
@@ -209,8 +209,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.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
c0=clip, D1=ErrorL2deriv)$root)
@@ -234,8 +234,8 @@
zfun <- function(x, z0, c0, D1, tol.z){
if(x == 0) return(0)
- lower <- q.l(D1)(distr::TruncQuantile)
- upper <- q.l(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(getdistrOption("TruncQuantile"))
+ upper <- q.l(D1)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = c0, xx = x, D1 = D1)$root)
@@ -284,8 +284,8 @@
zfun <- function(x, z0, c0, A0, D1, tol.z){
if(all(x == numeric(length(x)))) return(0)
- lower <- q.l(D1)(distr::TruncQuantile)
- upper <- q.l(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(getdistrOption("TruncQuantile"))
+ upper <- q.l(D1)(1-getdistrOption("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_asGRisk_c1.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -33,14 +33,14 @@
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
z.vec <- numeric(length(x.vec))
}else{
@@ -150,14 +150,14 @@
z <- z.start
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
z.vec <- matrix(0, ncol = k, nrow = length(x.vec))
}else{
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-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_v1.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -33,14 +33,14 @@
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
z.vec <- numeric(length(x.vec))
}else{
Modified: branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/R/getInfRobRegTypeIC_asUnOvShoot.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -152,14 +152,14 @@
RegSymm, Finfo, trafo, upper, maxiter, tol, warn){
radiusCurve <- neighbor at radiusCurve
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
radCx <- radiusCurve(x.vec)
Modified: branches/robast-1.1/pkg/ROptRegTS/inst/NEWS
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/inst/NEWS 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/inst/NEWS 2018-07-24 22:18:11 UTC (rev 1055)
@@ -16,7 +16,9 @@
under the hood:
+ wherever possible also use q.l internally instead of q to provide functionality in
IRKernel
-
++ changed calls to formerly exported objects from NAMESPACE distr to getdistrOption("<object>")
++ fixed large parts of the scripts
+
#######################################
version 1.0
#######################################
Modified: branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegAdaption.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -69,8 +69,8 @@
checkL2deriv(LM31)
distrExOptions(ErelativeTolerance, .Machine$double.eps^0.5)
-(LM32 <- NormLinRegInterceptFamily(RegDistr = K3, trafo = matrix(c(1,0), nrow = 1), nuisance = TRUE))
-distrExOptions(ErelativeTolerance, .Machine$double.eps^0.25)
+(LM32 <- NormLinRegInterceptFamily(RegDistr = K3-E(K3), trafo = matrix(c(1,0), nrow = 1), nuisance = TRUE))
+distrExOptions("ErelativeTolerance"= .Machine$double.eps^0.25)
checkL2deriv(LM32)
## infinitesimal robust model
Modified: branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegScale.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegScale.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/inst/scripts/NormLinRegScale.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -3,7 +3,6 @@
###############################################################################
require(ROptRegTS)
-require(RobRex)
###############################################################################
## Example 1 (1-dim., discrete Regressor)
@@ -39,7 +38,7 @@
Risks(IC21)
# AL-estimator from package RobRex
-system.time(IC.AL1 <- rgsOptIC.AL(r = 0.5, K = K1, check = TRUE), gcFirst = TRUE)
+system.time(IC.AL1 <- RobRex::rgsOptIC.AL(r = 0.5, K = K1, check = TRUE), gcFirst = TRUE)
checkIC(IC.AL1)
Risks(IC.AL1)
@@ -49,7 +48,7 @@
Risks(IC21c)
# AL-estimator from package RobRex
-system.time(IC.AL1c <- rgsOptIC.ALc(r = 0.5, K = K1, check = TRUE), gcFirst = TRUE)
+system.time(IC.AL1c <- RobRex::rgsOptIC.ALc(r = 0.5, K = K1, check = TRUE), gcFirst = TRUE)
checkIC(IC.AL1c)
Risks(IC.AL1c)
@@ -162,7 +161,7 @@
Risks(IC23)
# AL-estimator from package RobRex
-system.time(IC.AL3 <- rgsOptIC.AL(r = 0.5, K = K3, check = TRUE), gcFirst = TRUE)
+system.time(IC.AL3 <- RobRex::rgsOptIC.AL(r = 0.5, K = K3, check = TRUE), gcFirst = TRUE)
checkIC(IC.AL3)
Risks(IC.AL3)
@@ -172,7 +171,7 @@
Risks(IC23c)
# AL-estimator from package RobRex
-system.time(IC.AL3c <- rgsOptIC.ALc(r = 0.5, K = K3, check = TRUE), gcFirst = TRUE)
+system.time(IC.AL3c <- RobRex::rgsOptIC.ALc(r = 0.5, K = K3, check = TRUE), gcFirst = TRUE)
checkIC(IC.AL3c)
Risks(IC.AL3c)
Modified: branches/robast-1.1/pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R
===================================================================
--- branches/robast-1.1/pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.1/pkg/ROptRegTS/inst/scripts/UnderOverShootRiskCond.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -90,7 +90,7 @@
checkIC(IC32v) # takes some time
Risks(IC32v)
-distroptions("DefaultNrFFTGridPointsExponent", 8)
+distroptions("DefaultNrFFTGridPointsExponent"= 8)
system.time(IC42c <- optIC(model=RobLM4c, risk=fiUnOvShoot(width = tau/sqrt(n)), sampleSize = n), gcFirst = TRUE)
checkIC(IC42c) # takes some time
Risks(IC42c)
@@ -127,7 +127,7 @@
clipLo(IC13c) <- RealRandVariable(list(clipLo13), Domain=Reals())
stand(IC13c) <- as.matrix(stand3)
checkIC(IC13c)
-distroptions("DefaultNrFFTGridPointsExponent", 12)
+distroptions("DefaultNrFFTGridPointsExponent"= 12)
Risks(IC13c) <- getFiRiskRegTS(risk = fiUnOvShoot(width = tau/sqrt(n)),
ErrorDistr = Norm(), Regressor = K1,
neighbor = CondContNeighborhood(radius = 0,
@@ -163,7 +163,7 @@
clipLo(IC23c) <- RealRandVariable(list(clipLo23), Domain=Reals())
stand(IC23c) <- as.matrix(stand3)
checkIC(IC23c)
-distroptions("DefaultNrFFTGridPointsExponent", 8)
+distroptions("DefaultNrFFTGridPointsExponent"= 8)
Risks(IC23c) <- getFiRiskRegTS(risk = fiUnOvShoot(width = tau/sqrt(n)),
ErrorDistr = Norm(), Regressor = K2,
neighbor = CondContNeighborhood(radius = 0,
@@ -199,7 +199,7 @@
stand(IC13v) <- as.matrix(stand3)
checkIC(IC13v)
-distroptions("DefaultNrFFTGridPointsExponent", 12)
+distroptions("DefaultNrFFTGridPointsExponent"= 12)
Risks(IC13v) <- getFiRiskRegTS(risk = fiUnOvShoot(width = tau/sqrt(n)),
ErrorDistr = Norm(), Regressor = K1,
neighbor = CondTotalVarNeighborhood(radius = 0,
@@ -234,7 +234,7 @@
stand(IC23v) <- as.matrix(stand3)
checkIC(IC23v)
-distroptions("DefaultNrFFTGridPointsExponent", 8)
+distroptions("DefaultNrFFTGridPointsExponent"= 8)
Risks(IC23v) <- getFiRiskRegTS(risk = fiUnOvShoot(width = tau/sqrt(n)),
ErrorDistr = Norm(), Regressor = K2,
neighbor = CondTotalVarNeighborhood(radius = 0,
Modified: branches/robast-1.2/pkg/ROptRegTS/R/AllClass.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/AllClass.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/AllClass.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -160,8 +160,8 @@
radCurve <- object at neighbor@radiusCurve
if(is(D1, "UnivariateDistribution")){
if(is(D1, "AbscontDistribution")){
- 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))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(getdistrOption("TruncQuantile")))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - getdistrOption("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.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))
+ xlo <- ifelse(is.finite(q.l(D1)(0)), q.l(D1)(0), q.l(D1)(getdistrOption("TruncQuantile")))
+ xup <- ifelse(is.finite(q.l(D1)(1)), q.l(D1)(1), q.l(D1)(1 - getdistrOption("TruncQuantile")))
x <- seq(from = xlo, to = xup, by = 1e-3)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.2/pkg/ROptRegTS/R/getAsRiskRegTS.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/getAsRiskRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -282,8 +282,8 @@
neighbor = "CondNeighborhood"),
function(risk, ErrorL2deriv, Regressor, neighbor, clip, cent, stand){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, by = 0.01)
}else{
if(is(Regressor, "DiscreteDistribution"))
Modified: branches/robast-1.2/pkg/ROptRegTS/R/getFiRiskRegTS.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/getFiRiskRegTS.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/getFiRiskRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -62,7 +62,7 @@
eps <- neighbor at radius
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(Algo != "A"){
if(cont == "left"){
@@ -173,7 +173,7 @@
delta <- neighbor at radius
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(Algo != "A"){
if(cont == "left"){
@@ -289,17 +289,17 @@
eps <- neighbor at radiusCurve
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
b.vec <- sapply(x.vec, clip)
@@ -363,17 +363,17 @@
delta <- neighbor at radiusCurve
tau <- risk at width
n <- sampleSize
- m <- distr::DefaultNrFFTGridPointsExponent
+ m <- getdistrOption("DefaultNrFFTGridPointsExponent")
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
b.vec <- sapply(x.vec, clip)
Modified: branches/robast-1.2/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/getFixRobRegTypeIC_fiUnOvShoot.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -53,14 +53,14 @@
tol, warn, Algo, cont){
radiusCurve <- neighbor at radiusCurve
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
+ xupper <- ifelse(is.finite(q.l(Regressor)(1)), q.l(Regressor)(1), q.l(Regressor)(1 - getdistrOption("TruncQuantile")))
x.vec <- seq(from = xlower, to = xupper, length = 1000)
}else{
if(is(Regressor, "DiscreteDistribution"))
x.vec <- support(Regressor)
else
- x.vec <- unique(r(Regressor)(distr::RtoDPQ.e))
+ x.vec <- unique(r(Regressor)(getdistrOption("RtoDPQ.e")))
}
radCx <- radiusCurve(x.vec)
Modified: branches/robast-1.2/pkg/ROptRegTS/R/getInfCentRegTS.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/getInfCentRegTS.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -40,8 +40,8 @@
}
return(E(K, gu.fct, z = z, c0 = c0, D1 = D1))
}
- lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = ErrorL2deriv, K = Regressor)$root)
@@ -100,8 +100,8 @@
z*(1-p(D1)(z/x)) + x*(m1df(D1, z/x) - m1df(D1, b/x)) + b*p(D1)(b/x)
}
}
- lower <- q.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = ErrorL2deriv, x = Regressor)$root)
@@ -209,8 +209,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.l(ErrorL2deriv)(distr::TruncQuantile)
- upper <- q.l(ErrorL2deriv)(1-distr::TruncQuantile)
+ lower <- q.l(ErrorL2deriv)(getdistrOption("TruncQuantile"))
+ upper <- q.l(ErrorL2deriv)(1-getdistrOption("TruncQuantile"))
return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
c0=clip, D1=ErrorL2deriv)$root)
@@ -234,8 +234,8 @@
zfun <- function(x, z0, c0, D1, tol.z){
if(x == 0) return(0)
- lower <- q.l(D1)(distr::TruncQuantile)
- upper <- q.l(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(getdistrOption("TruncQuantile"))
+ upper <- q.l(D1)(1-getdistrOption("TruncQuantile"))
return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = c0, xx = x, D1 = D1)$root)
@@ -284,8 +284,8 @@
zfun <- function(x, z0, c0, A0, D1, tol.z){
if(all(x == numeric(length(x)))) return(0)
- lower <- q.l(D1)(distr::TruncQuantile)
- upper <- q.l(D1)(1-distr::TruncQuantile)
+ lower <- q.l(D1)(getdistrOption("TruncQuantile"))
+ upper <- q.l(D1)(1-getdistrOption("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.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-24 13:05:37 UTC (rev 1054)
+++ branches/robast-1.2/pkg/ROptRegTS/R/getInfRobRegTypeIC_asGRisk_c1.R 2018-07-24 22:18:11 UTC (rev 1055)
@@ -33,14 +33,14 @@
if(is(Regressor, "UnivariateDistribution")){
if(is(Regressor, "AbscontDistribution")){
- 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))
+ xlower <- ifelse(is.finite(q.l(Regressor)(0)), q.l(Regressor)(0), q.l(Regressor)(getdistrOption("TruncQuantile")))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 1055
More information about the Robast-commits
mailing list