[Robast-commits] r1040 - in pkg/ROptRegTS: . R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 23 22:56:49 CEST 2018
Author: ruckdeschel
Date: 2018-07-23 22:56:48 +0200 (Mon, 23 Jul 2018)
New Revision: 1040
Modified:
pkg/ROptRegTS/DESCRIPTION
pkg/ROptRegTS/NAMESPACE
pkg/ROptRegTS/R/ContIC.R
pkg/ROptRegTS/R/getIneffDiff.R
pkg/ROptRegTS/R/leastFavorableRadius.R
pkg/ROptRegTS/R/radiusMinimaxIC.R
pkg/ROptRegTS/inst/NEWS
pkg/ROptRegTS/inst/TOBEDONE
Log:
[ROptRegTS] merged branch 1.1 to trunk
Modified: pkg/ROptRegTS/DESCRIPTION
===================================================================
--- pkg/ROptRegTS/DESCRIPTION 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/DESCRIPTION 2018-07-23 20:56:48 UTC (rev 1040)
@@ -1,18 +1,15 @@
-Package: ROptRegTS
-Version: 0.9.1
-Date: 2013-09-12
-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), ROptEstOld(>= 0.9.2)
-Imports: methods, RandVar(>= 0.9.2), distr(>= 2.5.2), distrEx(>= 2.4)
-Author: Matthias Kohl <Matthias.Kohl at stamats.de>, Peter Ruckdeschel
-Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
-LazyLoad: yes
+Package: ROptEstOld
+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.
+Depends: R(>= 2.14.0), methods, distr(>= 2.5.2), distrEx(>= 2.2), RandVar(>= 0.9.2), evd
+Authors at R: person("Matthias", "Kohl", role=c("aut", "cre", "cph"), email="Matthias.Kohl at stamats.de")
ByteCompile: yes
License: LGPL-3
-Encoding: latin1
URL: http://robast.r-forge.r-project.org/
+Encoding: latin1
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: 696
+VCS/SVNRevision: 940
Modified: pkg/ROptRegTS/NAMESPACE
===================================================================
--- pkg/ROptRegTS/NAMESPACE 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/NAMESPACE 2018-07-23 20:56:48 UTC (rev 1040)
@@ -3,6 +3,11 @@
import("distrEx")
import("RandVar")
import("ROptEstOld")
+importFrom("grDevices", "grey")
+importFrom("graphics", "legend", "lines", "par", "title")
+importFrom("stats", "approxfun", "dbinom", "ecdf", "fft", "ks.test",
+ "optim", "optimize", "pbinom", "pnorm", "ppois", "qpois",
+ "uniroot")
exportClasses("RegTypeFamily",
"L2RegTypeFamily")
Modified: pkg/ROptRegTS/R/ContIC.R
===================================================================
--- pkg/ROptRegTS/R/ContIC.R 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/R/ContIC.R 2018-07-23 20:56:48 UTC (rev 1040)
@@ -1,7 +1,51 @@
+## Generating function
+ContIC <- function(name, CallL2Fam = call("L2ParamFamily"),
+ Curve = EuclRandVarList(RealRandVariable(Map = c(function(x){x}), Domain = Reals())),
+ Risks, Infos, clip = Inf, cent = 0, stand = as.matrix(1),
+ lowerCase = NULL, neighborRadius = 0){
+ if(missing(name))
+ name <- "IC of contamination type"
+ if(missing(Risks))
+ Risks <- list()
+ if(missing(Infos))
+ Infos <- matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message")))
+
+ if(any(neighborRadius < 0)) # radius vector?!
+ stop("'neighborRadius' has to be in [0, Inf]")
+ if(length(cent) != nrow(stand))
+ stop("length of centering constant != nrow of standardizing matrix")
+ if((length(clip) != 1) && (length(clip) != length(Curve)))
+ stop("length of clipping bound != 1 and != length of 'Curve'")
+ if(!is.null(lowerCase))
+ if(length(lowerCase) != nrow(stand))
+ stop("length of 'lowerCase' != nrow of standardizing matrix")
+ L2Fam <- eval(CallL2Fam)
+ if(!identical(dim(L2Fam at param@trafo), dim(stand)))
+ stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
+
+ contIC <- new("ContIC")
+ contIC at name <- name
+ contIC at Curve <- Curve
+ contIC at Risks <- Risks
+ contIC at Infos <- Infos
+ contIC at CallL2Fam <- CallL2Fam
+ contIC at clip <- clip
+ contIC at cent <- cent
+ contIC at stand <- stand
+ contIC at lowerCase <- lowerCase
+ contIC at neighborRadius <- neighborRadius
+
+ return(contIC)
+# return(new("ContIC", name = name, Curve = Curve, Risks = Risks, Infos = Infos,
+# CallL2Fam = CallL2Fam, clip = clip, cent = cent, stand = stand,
+# lowerCase = lowerCase, neighborRadius = neighborRadius))
+}
+
## generate IC
## for internal use only!
setMethod("generateIC", signature(neighbor = "ContNeighborhood",
- L2Fam = "L2RegTypeFamily"),
+ L2Fam = "L2ParamFamily"),
function(neighbor, L2Fam, res){
A <- res$A
a <- res$a
@@ -12,52 +56,47 @@
Y <- as(A %*% L2Fam at L2deriv - a, "EuclRandVariable")
if(nrvalues == 1){
if(!is.null(d)){
- ICfct[[1]] <- function(x){
- ind <- (Y(x) != 0)
- b*(ind*Y(x)/(ind*absY(x) + (1-ind)*1) + zi*(1-ind)*d)
- }
+ ICfct[[1]] <- function(x){}#
+ #ind <- (Y(x) != 0)
+ # b*(ind*Y(x)/(ind*absY(x) + (1-ind)) + zi*(1-ind)*d)
+ #}
body(ICfct[[1]]) <- substitute(
{ ind <- (Y(x) != 0)
- b*(ind*Y(x)/(ind*absY(x) + (1-ind)*1) + zi*(1-ind)*d) },
+ b*(ind*Y(x)/(ind*absY(x) + (1-ind)) + zi*(1-ind)*d) },
list(Y = Y at Map[[1]], absY = abs(Y)@Map[[1]], b = b, d = d,
zi = sign(L2Fam at param@trafo)))
}else{
- ICfct[[1]] <- function(x){ Y(x)*pmin(1, b/absY(x)) }
+ ICfct[[1]] <- function(x){}# Y(x)*pmin(1, b/absY(x)) }
body(ICfct[[1]]) <- substitute({ Y(x)*pmin(1, b/absY(x)) },
list(Y = Y at Map[[1]], absY = abs(Y)@Map[[1]], b = b))
}
- }
- else{
+ }else{
absY <- sqrt(Y %*% Y)
if(!is.null(d))
for(i in 1:nrvalues){
- ICfct[[i]] <- function(x){ ind <- (Yi(x) != 0) ; ind*b*Yi(x)/absY(x) + (1-ind)*d }
+ ICfct[[i]] <- function(x){}# ind <- (Yi(x) != 0) ; ind*b*Yi(x)/absY(x) + (1-ind)*d }
body(ICfct[[i]]) <- substitute({ ind <- (Yi(x) != 0) ; ind*b*Yi(x)/absY(x) + (1-ind)*d },
list(Yi = Y at Map[[i]], absY = absY at Map[[1]], b = b, d = d[i]))
}
else
for(i in 1:nrvalues){
- ICfct[[i]] <- function(x){ Yi(x)*pmin(1, b/absY(x)) }
+ ICfct[[i]] <- function(x){}# Yi(x)*pmin(1, b/absY(x)) }
body(ICfct[[i]]) <- substitute({ Yi(x)*pmin(1, b/absY(x)) },
list(Yi = Y at Map[[i]], absY = absY at Map[[1]], b = b))
}
}
return(ContIC(
- name = "IC of contamination type",
- CallL2Fam = call("L2RegTypeFamily",
+ name = "IC of contamination type",
+ CallL2Fam = call("L2ParamFamily",
name = L2Fam at name,
- distribution = L2Fam at distribution,
+ distribution = L2Fam at distribution,
+ distrSymm = L2Fam at distrSymm,
param = L2Fam at param,
props = L2Fam at props,
- ErrorDistr = L2Fam at ErrorDistr,
- ErrorSymm = L2Fam at ErrorSymm,
- RegDistr = L2Fam at RegDistr,
- RegSymm = L2Fam at RegSymm,
- Regressor = L2Fam at Regressor,
L2deriv = L2Fam at L2deriv,
- ErrorL2deriv = L2Fam at ErrorL2deriv,
- ErrorL2derivDistr = L2Fam at ErrorL2derivDistr,
- ErrorL2derivSymm = L2Fam at ErrorL2derivSymm,
+ L2derivSymm = L2Fam at L2derivSymm,
+ L2derivDistr = L2Fam at L2derivDistr,
+ L2derivDistrSymm = L2Fam at L2derivDistrSymm,
FisherInfo = L2Fam at FisherInfo),
Curve = EuclRandVarList(EuclRandVariable(Map = ICfct, Domain = Y at Domain,
Range = Y at Range)),
@@ -70,3 +109,80 @@
Infos = matrix(res$info, ncol = 2,
dimnames = list(character(0), c("method", "message")))))
})
+
+## Access methods
+setMethod("clip", "ContIC", function(object) object at clip)
+setMethod("cent", "ContIC", function(object) object at cent)
+setMethod("stand", "ContIC", function(object) object at stand)
+setMethod("lowerCase", "ContIC", function(object) object at lowerCase)
+setMethod("neighborRadius", "ContIC", function(object) object at neighborRadius)
+
+## replace methods
+setReplaceMethod("clip", "ContIC",
+ function(object, value){
+ stopifnot(is.numeric(value))
+ L2Fam <- eval(object at CallL2Fam)
+ res <- list(A = object at stand, a = object at cent, b = value, d = object at lowerCase,
+ risk = object at Risks, info = object at Infos)
+ object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
+ L2Fam = L2Fam, res = res)
+ addInfo(object) <- c("clip<-", "The clipping bound has been changed")
+ addInfo(object) <- c("clip<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
+setReplaceMethod("cent", "ContIC",
+ function(object, value){
+ stopifnot(is.numeric(value))
+ L2Fam <- eval(object at CallL2Fam)
+ res <- list(A = object at stand, a = value, b = object at clip, d = object at lowerCase,
+ risk = object at Risks, info = object at Infos)
+ object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
+ L2Fam = L2Fam, res = res)
+ addInfo(object) <- c("cent<-", "The centering constant has been changed")
+ addInfo(object) <- c("cent<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
+setReplaceMethod("stand", "ContIC",
+ function(object, value){
+ stopifnot(is.matrix(value))
+ L2Fam <- eval(object at CallL2Fam)
+ res <- list(A = value, a = object at cent, b = object at clip, d = object at lowerCase,
+ risk = object at Risks, info = object at Infos)
+ object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
+ L2Fam = L2Fam, res = res)
+ addInfo(object) <- c("stand<-", "The standardizing matrix has been changed")
+ addInfo(object) <- c("stand<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
+setReplaceMethod("lowerCase", "ContIC",
+ function(object, value){
+ stopifnot(is.null(value)||is.numeric(value))
+ L2Fam <- eval(object at CallL2Fam)
+ res <- list(A = object at stand, a = object at cent, b = object at clip, d = value,
+ risk = object at Risks, info = object at Infos)
+ object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
+ L2Fam = L2Fam, res = res)
+ addInfo(object) <- c("lowerCase<-", "The slot 'lowerCase' has been changed")
+ addInfo(object) <- c("lowerCase<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
+setReplaceMethod("neighborRadius", "ContIC",
+ function(object, value){
+ object at neighborRadius <- value
+ if(any(value < 0)) # radius vector?!
+ stop("'value' has to be in [0, Inf]")
+ addInfo(object) <- c("neighborRadius<-", "The slot 'neighborRadius' has been changed")
+ addInfo(object) <- c("neighborRadius<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
+setReplaceMethod("CallL2Fam", "ContIC",
+ function(object, value){
+ L2Fam <- eval(value)
+ res <- list(A = object at stand, a = object at cent, b = object at clip, d = object at lowerCase,
+ risk = object at Risks, info = object at Infos)
+ object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
+ L2Fam = L2Fam, res = res)
+ addInfo(object) <- c("CallL2Fam<-", "The slot 'CallL2Fam' has been changed")
+ addInfo(object) <- c("CallL2Fam<-", "The entries in 'Risks' and 'Infos' may be wrong")
+ object
+ })
Modified: pkg/ROptRegTS/R/getIneffDiff.R
===================================================================
--- pkg/ROptRegTS/R/getIneffDiff.R 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/R/getIneffDiff.R 2018-07-23 20:56:48 UTC (rev 1040)
@@ -22,12 +22,13 @@
ineffUp <- res$b^2/upRisk
else
ineffUp <- (sum(diag(res$A %*% t(trafo))) - res$b^2*(radius^2-upRad^2))/upRisk
- assign("ineff", ineffUp, envir = sys.frame(which = -4))
+## changed: shakey... assign("ineff", ineffUp, envir = sys.frame(which = -4))
+# return(ineffUp - ineffLo)
+ return(c(ineff=ineffUp,ineffDiff=ineffUp - ineffLo))
+ }else{
if(is(L2Fam at RegDistr, "MultivariateDistribution"))
cat("current radius:\t", radius, "\tMSE-inefficiency difference:\t", ineffUp - ineffLo, "\n")
- return(ineffUp - ineffLo)
- }else{
if(is(L2Fam at ErrorDistr, "UnivariateDistribution")){
if((length(L2Fam at ErrorL2deriv) == 1)
& is(L2Fam at ErrorL2deriv[[1]], "RealRandVariable")){
@@ -64,10 +65,11 @@
ineffUp <- res$b^2/upRisk
else
ineffUp <- (sum(diag(res$A%*%t(trafo))) - res$b^2*(radius^2-upRad^2))/upRisk
- assign("ineff", ineffUp, envir = sys.frame(which = -4))
+ ## changed: shakey assign("ineff", ineffUp, envir = sys.frame(which = -4))
cat("current radius:\t", radius, "\tMSE-inefficiency difference:\t", ineffUp - ineffLo, "\n")
- return(ineffUp - ineffLo)
+ ## return(ineffUp - ineffLo)
+ return(c(ineff=ineffUp,ineffDiff=ineffUp - ineffLo))
}else{
stop("not yet implemented")
}
Modified: pkg/ROptRegTS/R/leastFavorableRadius.R
===================================================================
--- pkg/ROptRegTS/R/leastFavorableRadius.R 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/R/leastFavorableRadius.R 2018-07-23 20:56:48 UTC (rev 1040)
@@ -18,7 +18,7 @@
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
if(L2derivDim == 1){
- leastFavFct <- function(r, L2Fam, neighbor, risk, rho,
+ leastFavFct.1 <- function(r, L2Fam, neighbor, risk, rho,
upper.b, MaxIter, eps, warn){
loRad <- r*rho
upRad <- r/rho
@@ -63,16 +63,23 @@
clip = resUp$b, cent = resUp$a, stand = resUp$A,
trafo = L2Fam at param@trafo)[[1]]
}
- leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
- tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
- risk = risk, loRad = loRad, upRad = upRad, loRisk = loRisk,
- upRisk = upRisk, upper.b = upper.b, eps = eps, MaxIter = MaxIter,
- warn = warn)$root
+
+ ineff <- NULL
+ getIneffDiff.1 <- function(x){
+ res <- getIneffDiff(x, L2Fam = L2Fam, neighbor = neighbor,
+ upper.b = upper.b, risk = risk, loRad = loRad, upRad = upRad,
+ loRisk = loRisk, upRisk = upRisk, eps = .Machine$double.eps^0.25,
+ MaxIter = MaxIter, warn = warn)
+ ineff <<- res["ineff"]
+ return(res["ineffDiff"])
+ }
+ leastFavR <- uniroot(getIneffDiff.1, lower = lower, upper = upper,
+ tol = .Machine$double.eps^0.25)$root
options(ow)
cat("current radius:\t", r, "\tinefficiency:\t", ineff, "\n")
return(ineff)
}
- leastFavR <- optimize(leastFavFct, lower = 1e-4, upper = upRad,
+ leastFavR <- optimize(leastFavFct.1, lower = 1e-4, upper = upRad,
tol = .Machine$double.eps^0.25, maximum = TRUE,
L2Fam = L2Fam, neighbor = neighbor, risk = risk,
rho = rho, upper.b = upper, MaxIter = maxiter,
@@ -104,7 +111,7 @@
ErrorL2derivDistrSymm <- new("DistrSymmList", L2)
}
}
- leastFavFct <- function(r, L2Fam, neighbor, risk, rho,
+ leastFavFct.p <- function(r, L2Fam, neighbor, risk, rho,
z.start, A.start, upper.b, MaxIter, eps, warn){
loRad <- r*rho
upRad <- r/rho
@@ -155,11 +162,17 @@
clip = resUp$b, cent = resUp$a, stand = resUp$A,
trafo = trafo)[[1]]
}
- leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
- tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
- z.start = z.start, A.start = A.start, upper.b = upper.b, risk = risk,
- loRad = loRad, upRad = upRad, loRisk = loRisk, upRisk = upRisk,
- eps = eps, MaxIter = MaxIter, warn = warn)$root
+ ineff <- NULL
+ getIneffDiff.p <- function(x){
+ res <- getIneffDiff(x, L2Fam = L2Fam, neighbor = neighbor,
+ z.start = z.start, A.start = A.start, upper.b = upper.b, risk = risk,
+ loRad = loRad, upRad = upRad, loRisk = loRisk, upRisk = upRisk,
+ eps = .Machine$double.eps^0.25, MaxIter = MaxIter, warn = warn)
+ ineff <<- res["ineff"]
+ return(res["ineffDiff"])
+ }
+ leastFavR <- uniroot(getIneffDiff.p, lower = lower, upper = upper,
+ tol = .Machine$double.eps^0.25)$root
options(ow)
cat("current radius:\t", r, "\tinefficiency:\t", ineff, "\n")
return(ineff)
@@ -175,7 +188,7 @@
}
if(is.null(A.start)) A.start <- L2Fam at param@trafo
- leastFavR <- optimize(leastFavFct, lower = 1e-4, upper = upRad,
+ leastFavR <- optimize(leastFavFct.p, lower = 1e-4, upper = upRad,
tol = .Machine$double.eps^0.25, maximum = TRUE,
L2Fam = L2Fam, neighbor = neighbor, risk = risk,
rho = rho, z.start = z.start, A.start = A.start,
Modified: pkg/ROptRegTS/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptRegTS/R/radiusMinimaxIC.R 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/R/radiusMinimaxIC.R 2018-07-23 20:56:48 UTC (rev 1040)
@@ -61,11 +61,17 @@
trafo = L2Fam at param@trafo)[[1]]
}
- leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
- tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
- upper.b = upper.b, risk = risk, loRad = loRad, upRad = upRad,
- loRisk = loRisk, upRisk = upRisk, eps = tol,
- MaxIter = maxiter, warn = warn)$root
+ ineff <- NULL
+ getIneffDiff.1 <- function(x){
+ res <- getIneffDiff(x, L2Fam = L2Fam, neighbor = neighbor,
+ upper.b = upper.b, risk = risk, loRad = loRad, upRad = upRad,
+ loRisk = loRisk, upRisk = upRisk, eps = .Machine$double.eps^0.25,
+ MaxIter = maxiter, warn = warn)
+ ineff <<- res["ineff"]
+ return(res["ineffDiff"])
+ }
+ leastFavR <- uniroot(getIneffDiff.1, lower = lower, upper = upper,
+ tol = .Machine$double.eps^0.25)$root
neighbor at radius <- leastFavR
res <- getInfRobRegTypeIC(ErrorL2deriv = L2Fam at ErrorL2derivDistr[[1]],
Regressor = L2Fam at RegDistr, risk = risk, neighbor = neighbor,
@@ -152,11 +158,17 @@
trafo = trafo)[[1]]
}
- leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
- tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
- z.start = z.start, A.start = A.start, upper.b = upper.b, risk = risk,
- loRad = loRad, upRad = upRad, loRisk = loRisk, upRisk = upRisk,
- eps = tol, MaxIter = maxiter, warn = warn)$root
+ ineff <- NULL
+ getIneffDiff.p <- function(x){
+ res <- getIneffDiff(x, L2Fam = L2Fam, neighbor = neighbor,
+ z.start = z.start, A.start = A.start, upper.b = upper.b, risk = risk,
+ loRad = loRad, upRad = upRad, loRisk = loRisk, upRisk = upRisk,
+ eps = .Machine$double.eps^0.25, MaxIter = maxiter, warn = warn)
+ ineff <<- res["ineff"]
+ return(res["ineffDiff"])
+ }
+ leastFavR <- uniroot(getIneffDiff.p, lower = lower, upper = upper,
+ tol = .Machine$double.eps^0.25)$root
neighbor at radius <- leastFavR
res <- getInfRobRegTypeIC(ErrorL2deriv = ErrorL2deriv,
Regressor = L2Fam at RegDistr, risk = risk, neighbor = neighbor,
Modified: pkg/ROptRegTS/inst/NEWS
===================================================================
--- pkg/ROptRegTS/inst/NEWS 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/inst/NEWS 2018-07-23 20:56:48 UTC (rev 1040)
@@ -1,5 +1,5 @@
###############################################################################
-## News: to package ROptRegTS
+## News: to package ROptEstOld
###############################################################################
(first two numbers of package versions do not necessarily reflect
@@ -8,48 +8,56 @@
information)
#######################################
-version 0.8
+version 1.1
#######################################
-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
+user-visible CHANGES:
++ DESCRIPTION tag SVNRevision changed to VCS/SVNRevision
+under the hood:
++ wherever possible also use q.l internally instead of q to
+ provide functionality in IRKernel
+
#######################################
-version 0.7
+version 1.0
#######################################
user-visible CHANGES:
++ title changed to title style / capitalization
-+ now depends on ROptEstOld!
+#######################################
+version 0.9
+#######################################
+user-visible CHANGES:
++ EVD functionality (including Gumbel distribution) has been
+moved from distrEx to new pkg RobExtremes; to avoid failure
+of ROptEstOld, this functionality has been copied to ROptEstOld
+as well.
+
GENERAL ENHANCEMENTS:
++ cleaned DESCRIPTION and NAMESPACE file as to Imports/Depends
-+ added tests/Examples folder with file ROptRegTS-Ex.Rout.save to have
- some automatic testing
-+ added TOBEDONE (sic!) files; in English (for possible collaborators)
-+ added keyword robust and made some minor corrections ...
-+ added/updated NEWS files, updated CITATION files using code by A. Zeileis
+under the hood:
-+ Rd-parsing:
- * patch for Brian Ripley's
- Re: [Rd] Warning: missing text for item ... in \describe?
- * fixed errors / warnings in .Rd files detected by parser 2
- (c.f. [Rd] More intensive checking of R help files, Prof Brian Ripley, 09.01.2009 10:25)
++ added .Rbuildignore
+
+BUGFIXES
-+ svn-revision-tags
- * added in all DESCRIPTION files
- * added field "Encoding: latin1" to all DESCRIPTION files because
- substituting $LastChangedDate by svn would cause problems for
- packages built under Windows (German) local when checking under Linux.
-+ removed pdf-file from version control - Rnw-file is sufficient
+#######################################
+version 0.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
+
#######################################
-version 0.6.1
+version 0.7
#######################################
-+ introduced option("newDevice") to control new opening of graphic devices
-+ 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
+
+user-visible CHANGES:
+
++ introduced package ROptEstOld for use with ROptRegTS and RobRex
++ removed symmetry and DistributionSymmetry implementation to make ROptEstOld compatible with distr 2.2
Modified: pkg/ROptRegTS/inst/TOBEDONE
===================================================================
--- pkg/ROptRegTS/inst/TOBEDONE 2018-07-23 20:48:42 UTC (rev 1039)
+++ pkg/ROptRegTS/inst/TOBEDONE 2018-07-23 20:56:48 UTC (rev 1040)
@@ -1,3 +1,6 @@
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-to be done in package ROptRegTS
+to be done in package RandVar
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
++move symmetry slots/classes out of RobAStBase into RandVar
++automatic setting of symmetry slots for specific operations
More information about the Robast-commits
mailing list