[Robast-commits] r1143 - in branches/robast-1.2/pkg/RobAStBase: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 15 22:40:57 CEST 2018
Author: ruckdeschel
Date: 2018-08-15 22:40:56 +0200 (Wed, 15 Aug 2018)
New Revision: 1143
Modified:
branches/robast-1.2/pkg/RobAStBase/NAMESPACE
branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R
branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-1.2/pkg/RobAStBase/inst/NEWS
branches/robast-1.2/pkg/RobAStBase/man/internals.Rd
branches/robast-1.2/pkg/RobAStBase/man/kStepEstimator.Rd
Log:
[RobAStBase] branch 1.2:
+ .filterEargs is renamed to .filterEargsWEargList and now calls distrEx::.filterEargs
+ the respective calls to it are renamed
+ in kStepEstimator, the solution with timings to be commented in and out has been replaced by permanent calls to proc.time()
(without creating new environments through functions calls to system.time)
Modified: branches/robast-1.2/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/NAMESPACE 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/NAMESPACE 2018-08-15 20:40:56 UTC (rev 1143)
@@ -89,4 +89,4 @@
export(".rescalefct",".plotRescaledAxis",".makedotsP",".makedotsLowLevel",".SelectOrderData")
export(".merge.lists")
export("InfoPlot", "ComparePlot", "PlotIC")
-export(".fixInLiesInSupport", "..IntegrateArgs", ".filterEargs")
\ No newline at end of file
+export(".fixInLiesInSupport", ".filterEargsWEargList")
Modified: branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R 2018-08-15 20:40:56 UTC (rev 1143)
@@ -7,7 +7,7 @@
nrvalues <- nrow(trafo)
Distr <- L2Fam at distribution
- dotsI <- .filterEargs(list(...))
+ dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
@@ -20,17 +20,13 @@
res[i] <- do.call(E, Eargs)
}
- integrandA <- function(x, IC.i, L2.j){
- return(IC.i(x)*L2.j(x))
- }
erg <- matrix(0, ncol = dims, nrow = nrvalues)
for(i in 1:nrvalues)
for(j in 1:dims){
- Eargs <- c(list(object = Distr, fun = integrandA,
- IC.i = IC.v at Map[[i]], L2.j = L2deriv at Map[[j]]),
- dotsI)
+ integrandA <- function(x)IC.v at Map[[i]](x)*L2deriv at Map[[j]](x)
+ Eargs <- c(list(object = Distr, fun = integrandA),dotsI)
erg[i, j] <- do.call(E, Eargs)
}
@@ -172,13 +168,8 @@
})
## comment 20180809: reverted changes in rev 1110
-..IntegrateArgs <- c("lowerTruncQuantile", "upperTruncQuantile",
- "IQR.fac", "subdivisions", "rel.tol", "abs.tol", "stop.on.error",
- "order", "useApply")
-
-.filterEargs <- function(dots){
- dotsI <- list()
- for(item in ..IntegrateArgs) dotsI[[item]] <- dots[[item]]
+.filterEargsWEargList <- function(dots){
+ dotsI <- .filterEargs(dots)
if(!is.null(dots[["E.argList"]])){
E.argList <- dots[["E.argList"]]
if(is.call(E.argList)) eval(E.argList)
@@ -189,4 +180,4 @@
}
return(dotsI)
-}
\ No newline at end of file
+}
Modified: branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R 2018-08-15 20:40:56 UTC (rev 1143)
@@ -30,7 +30,7 @@
if(dimension(Domain(IC at Curve[[1]])) != dimension(img(L2Fam at distribution)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
- dotsI <- .filterEargs(list(...))
+ dotsI <- .filterEargsWEargList(list(...))
if(!is.null(dotsI$useApply)) dotsI$useApply <- FALSE
if(missing(withCheck)) withCheck <- TRUE
Modified: branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R 2018-08-15 20:40:56 UTC (rev 1143)
@@ -1,6 +1,6 @@
getBoundedIC <- function(L2Fam, D=trafo(L2Fam at param),...){
- dotsI <- .filterEargs(list(...))
+ dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
FI <- FisherInfo(L2Fam)
Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-15 20:40:56 UTC (rev 1143)
@@ -24,10 +24,9 @@
setMethod("neighborRadius","ANY",function(object)NA)
-.addTime <- function(timold,timnew,namenew){
- nameold <- rownames(timold)
- tim <- rbind(timold,timnew)
- rownames(tim) <- c(nameold,namenew)
+.addTime <- function(timold,namenew){
+ tim <- rbind(timold,proc.time())
+ rownames(tim) <- c(rownames(timold),namenew)
return(tim)
}
@@ -37,6 +36,16 @@
if(length(d)==4L && d[2]==1L && d[4] == 1L) dim(x) <- d[c(1,3)]
x }
+### taken from: base::system.time ::
+ppt <- function(y) {
+ if (!is.na(y[4L]))
+ y[1L] <- y[1L] + y[4L]
+ if (!is.na(y[5L]))
+ y[2L] <- y[2L] + y[5L]
+ paste(formatC(y[1L:3L]), collapse = " ")
+}
+
+
### no dispatch on top layer -> keep product structure of dependence
kStepEstimator <- function(x, IC, start = NULL, steps = 1L,
useLast = getRobAStBaseOption("kStepUseLast"),
@@ -48,21 +57,20 @@
withLogScale = TRUE, withEvalAsVar = TRUE,
withMakeIC = FALSE, E.argList = NULL){
- if(missing(IC.UpdateInKer)) IC.UpdateInKer <- NULL
+ time <- proc.time()
+ on.exit(message("Timing stopped at: ", ppt(proc.time() - time)))
## save call
es.call <- match.call()
es.call[[1]] <- as.name("kStepEstimator")
if(is.null(E.argList)) E.argList <- list()
if(is.null(E.argList$useApply)) E.argList$useApply <- FALSE
+ if(missing(IC.UpdateInKer)) IC.UpdateInKer <- NULL
## get some dimensions
-##-t-## syt <- system.time({
L2Fam <- eval(CallL2Fam(IC))
-##-t-## })
-##-t-## sytm <- matrix(syt,nrow=1)
-##-t-## rownames(sytm) <- "eval(CallL2Fam(IC))"
-##-t-## colnames(sytm) <- names(syt)
+ sytm <- rbind(time,"eval(CallL2Fam(IC))"=proc.time())
+ colnames(sytm) <- names(time)
Param <- param(L2Fam)
tf <- trafo(L2Fam,Param)
@@ -112,20 +120,17 @@
### use dispatch here (dispatch only on start)
#a.var <- if( is(start, "Estimate")) asvar(start) else NULL
-##-t-## syt <- system.time({
+
IC.UpdateInKer.0 <- if(is(start,"ALEstimate")) pIC(start) else NULL
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,"pIC(start)")
+ sytm <- .addTime(sytm,"pIC(start)")
## pIC(start) instead of start at pIC to potentially eval a call
force(startArgList)
-##-t-## syt <- system.time({
start.val <- kStepEstimator.start(start, x=x0, nrvalues = k,
na.rm = na.rm, L2Fam = L2Fam,
startList = startArgList)
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,"kStepEstimator.start")
+ sytm <- .addTime(sytm,"kStepEstimator.start")
### use Logtransform here in scale models
sclname <- ""
@@ -163,7 +168,7 @@
useApply = FALSE)
return(Eres)}
-##-t-## updStp <- 0
+ updStp <- 0
### update - function
updateStep <- function(u.theta, theta, IC, L2Fam, Param,
withPreModif = FALSE,
@@ -171,39 +176,29 @@
withEvalAsVar.0 = FALSE
){
-##-t-## updStp <<- updStp + 1
+ updStp <<- updStp + 1
if(withPreModif){
main(Param)[] <- .deleteDim(u.theta[idx])
# print(Param)
if (lnx) nuisance(Param)[] <- .deleteDim(u.theta[nuis.idx])
# print(Param)
# print(L2Fam)
-##-t-## syt <- system.time({
L2Fam <- modifyModel(L2Fam, Param,
.withL2derivDistr = L2Fam at .withEvalL2derivDistr)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("modifyModel-PreModif-",updStp))
+ sytm <<- .addTime(sytm,paste("modifyModel-PreModif-",updStp))
# print(L2Fam)
-##-t-## syt <- system.time({
modifyICargs <- c(list(L2Fam, IC, withMakeIC = FALSE), E.argList)
IC <- do.call(modifyIC(IC),modifyICargs)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("modifyIC-PreModif-",updStp))
+ sytm <<- .addTime(sytm,paste("modifyIC-PreModif-",updStp))
if(steps==1L && withMakeIC){
-##-t-## syt <- system.time({
makeICargs <- c(list(IC, L2Fam),E.argList)
IC <- do.call(makeIC, makeICargs)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("modifyIC-makeIC-",updStp))
-# IC at modifyIC <- oldmodifIC
+ sytm <<- .addTime(sytm,paste("modifyIC-makeIC-",updStp))
}
- # print(IC)
}
-##-t-## syt <- system.time({
IC.c <- as(diag(p) %*% IC at Curve, "EuclRandVariable")
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("IC.c <- as(diag(p) %*%-",updStp))
+ sytm <<- .addTime(sytm,paste("IC.c <- as(diag(p) %*%-",updStp))
# print(theta)
tf <- trafo(L2Fam, Param)
@@ -211,7 +206,6 @@
IC.tot.0 <- NULL
# print(Dtau)
if(!.isUnitMatrix(Dtau)){
- # print("HU1!")
Dminus <- distr::solve(Dtau, generalized = TRUE)
projker <- diag(k) - Dminus %*% Dtau
@@ -224,43 +218,32 @@
if(!is.null(IC.UpdateInKer)&&!is(IC.UpdateInKer,"IC"))
warning("'IC.UpdateInKer' is not of class 'IC'; we use default instead.")
if(is.null(IC.UpdateInKer)){
-##-t-## syt <- system.time({
getBoundedICargs <- c(list(L2Fam, D = projker),E.argList)
IC.tot2 <- do.call(getBoundedIC, getBoundedICargs)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("getBoundedIC-",updStp))
+ sytm <<- .addTime(sytm,paste("getBoundedIC-",updStp))
}else{
-##-t-## syt <- system.time({
IC.tot2 <- as(projker %*% IC.UpdateInKer at Curve, "EuclRandVariable")
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("IC.tot2<-as(projker...-",updStp))
+ sytm <<- .addTime(sytm,paste("IC.tot2<-as(projker...-",updStp))
}
IC.tot2.isnull <- FALSE
IC.tot.0 <- IC.tot1 + IC.tot2
}else{ if(is.null(IC.UpdateInKer.0)){
IC.tot.0 <- NULL
}else{
-##-t-## syt <- system.time({
if(is.call(IC.UpdateInKer.0))
IC.UpdateInKer.0 <- eval(IC.UpdateInKer.0)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("eval(IC.UpdateInKer.0)-",updStp))
-##-t-## syt <- system.time({
+ sytm <<- .addTime(sytm,paste("eval(IC.UpdateInKer.0)-",updStp))
IC.tot.0 <- IC.tot1 + as(projker %*%
IC.UpdateInKer.0 at Curve,
"EuclRandVariable")
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("IC.tot.0 <- IC.tot1 + as(proj-",updStp))
+ sytm <<- .addTime(sytm,paste("IC.tot.0 <- IC.tot1 + as(proj-",updStp))
}
}
IC.tot <- IC.tot1
if(!IC.tot2.isnull) IC.tot <- IC.tot1 + IC.tot2
-##-t-## syt <- system.time({
indS <- liesInSupport(distribution(L2Fam),x0,checkFin=TRUE)
-# print(str(evalRandVar(IC.tot, x0)))
correct <- rowMeans(t(t(.ensureDim2(evalRandVar(IC.tot, x0)))*indS), na.rm = na.rm)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("Dtau-not-Unit:correct <- rowMeans-",updStp))
+ sytm <<- .addTime(sytm,paste("Dtau-not-Unit:correct <- rowMeans-",updStp))
iM <- is.matrix(u.theta)
names(correct) <- if(iM) rownames(u.theta) else names(u.theta)
if(logtrf){
@@ -272,16 +255,10 @@
theta <- (tf$fct(u.theta[idx]))$fval
}else{
-# print("HU2!")
-##-t-## syt <- system.time({
indS <- liesInSupport(distribution(L2Fam),x0,checkFin=TRUE)
correct <- rowMeans(t(t(.ensureDim2(evalRandVar(IC.c, x0)))*indS), na.rm = na.rm)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("Dtau=Unit:correct <- rowMeans-",updStp))
+ sytm <<- .addTime(sytm,paste("Dtau=Unit:correct <- rowMeans-",updStp))
iM <- is.matrix(theta)
-# print(sclname)
-# print(names(theta))
-# print(str(theta))
names(correct) <- if(iM) rownames(theta) else names(theta)
if(logtrf){
scl <- if(iM) theta[sclname,1] else theta[sclname]
@@ -294,63 +271,43 @@
IC.tot <- IC.c
u.theta <- theta
}
-# print("HU3!")
var0 <- u.var <- NULL
if(with.u.var){
cnms <- if(is.null(names(u.theta))) colnames(Dtau) else names(u.theta)
if(!is.null(IC.tot.0)){
-##-t-## syt <- system.time({
u.var <- substitute(do.call(cfct, args = list(L2F0, IC0,
dim0, dimn0)), list(cfct = cvar.fct,
L2F0 = L2Fam, IC0 = IC.tot.0, dim0 = k,
dimn0 = list(cnms,cnms)))
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("u.var-",updStp))
-##-t-## syt <- system.time({
+ sytm <<- .addTime(sytm,paste("u.var-",updStp))
if(withEvalAsVar.0) u.var <- eval(u.var)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("u.var-eval-",updStp))
- # matrix(E(L2Fam, IC.tot.0 %*% t(IC.tot.0)),
- # k,k, dimnames = list(cnms,cnms))
+ sytm <<- .addTime(sytm,paste("u.var-eval-",updStp))
}
if(!var.to.be.c){
-##-t-## syt <- system.time({
var0 <- substitute(do.call(cfct, args = list(L2F0, IC0,
dim0, dimn0)), list(cfct = cvar.fct,
L2F0 = L2Fam, IC0 = IC.c, dim0 = p))
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("var0-",updStp))
-##-t-## syt <- system.time({
+ sytm <<- .addTime(sytm,paste("var0-",updStp))
if(withEvalAsVar.0) var0 <- eval(var0)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("var0-eval-",updStp))
+ sytm <<- .addTime(sytm,paste("var0-eval-",updStp))
}
}
if(withPostModif){
main(Param)[] <- .deleteDim(u.theta[idx])
if (lnx) nuisance(Param)[] <- .deleteDim(u.theta[nuis.idx])
-# print(L2Fam)
-##-t-## syt <- system.time({
L2Fam <- modifyModel(L2Fam, Param,
.withL2derivDistr = L2Fam at .withEvalL2derivDistr)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("modifyModel-PostModif-",updStp))
-# print(L2Fam)
-##-t-## syt <- system.time({
+ sytm <<- .addTime(sytm,paste("modifyModel-PostModif-",updStp))
modifyICargs <- c(list(L2Fam, IC, withMakeIC = withMakeIC), E.argList)
IC <- do.call(modifyIC(IC),modifyICargs)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("modifyIC-PostModif-",updStp))
-# print(IC)
+ sytm <<- .addTime(sytm,paste("modifyIC-PostModif-",updStp))
}
-##-t-## syt <- system.time({
li <- list(IC = IC, Param = Param, L2Fam = L2Fam,
theta = theta, u.theta = u.theta, u.var = u.var,
var = var0, IC.tot = IC.tot, IC.c = IC)
-##-t-## })
-##-t-## sytm <<- .addTime(sytm,syt,paste("li <- list(IC = IC,...-",updStp))
+ sytm <<- .addTime(sytm,paste("li <- list(IC = IC,...-",updStp))
return(li)
}
@@ -362,46 +319,33 @@
### iteration
-# print(IC at Risks$asCov)
-# print(Risks(IC)$asCov)
-
ksteps <- matrix(0,ncol=steps, nrow = p)
uksteps <- matrix(0,ncol=steps, nrow = k)
rownames(ksteps) <- est.names
rownames(uksteps) <- u.est.names
if(!is(modifyIC(IC), "NULL") ){
for(i in 1:steps){
-# modif.old <- modifyIC(IC)
if(i>1){
IC <- upd$IC
L2Fam <- upd$L2Fam
-##-t-## syt <- system.time({
if((i==steps)&&withMakeIC){
makeICargs <- c(list(IC, L2Fam),E.argList)
IC <- do.call(makeIC, makeICargs)
+ sytm <- .addTime(sytm,paste("makeIC-",i))
}
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,paste("makeIC-",i))
-# IC at modifyIC <- modif.old
Param <- upd$Param
tf <- trafo(L2Fam, Param)
withPre <- FALSE
}else withPre <- TRUE
-##-t-## syt <- system.time({
upd <- updateStep(u.theta,theta,IC, L2Fam, Param,
withPreModif = withPre,
withPostModif = (steps>i) | useLast,
with.u.var = (i==steps),
withEvalAsVar.0 = (i==steps))
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,paste("UpdStep-",i))
# print(upd$u.theta); print(upd$theta)
uksteps[,i] <- u.theta <- upd$u.theta
-# print(str(upd$theta))
-# print(nrow(ksteps))
ksteps[,i] <- theta <- upd$theta
-##-t-## syt <- system.time({
if(withICList)
ICList[[i]] <- .fixInLiesInSupport(
new("InfluenceCurve",
@@ -410,8 +354,7 @@
Infos = matrix(c("",""),ncol=2),
Curve = EuclRandVarList(upd$IC.tot)),
distr = distribution(upd$L2Fam))
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,paste("ICList-",i))
+ sytm <- .addTime(sytm,paste("ICList-",i))
if(withPICList)
pICList[[i]] <- .fixInLiesInSupport(upd$IC.c,distribution(upd$L2Fam))
u.var <- upd$u.var
@@ -426,13 +369,11 @@
tf <- trafo(L2Fam, Param)
Infos <- rbind(Infos, c("kStepEstimator",
"computation of IC, trafo, asvar and asbias via useLast = TRUE"))
-##-t-## syt <- system.time({
if(withMakeIC){
makeICargs <- c(list(IC, L2Fam),E.argList)
IC <- do.call(makeIC, makeICargs)
+ sytm <- .addTime(sytm,"makeIC-useLast")
}
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,"makeIC-useLast")
}else{
Infos <- rbind(Infos, c("kStepEstimator",
"computation of IC, trafo, asvar and asbias via useLast = FALSE"))
@@ -440,11 +381,8 @@
}else{
if(steps > 1)
stop("slot 'modifyIC' of 'IC' is 'NULL'!")
-##-t-## syt <- system.time({
upd <- updateStep(u.theta,theta,IC, L2Fam, Param,withPreModif = FALSE,
withPostModif = TRUE)
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,paste("UpdStep-",i))
theta <- upd$theta
u.theta <- upd$u.theta
var0 <- upd$var
@@ -478,13 +416,11 @@
asVar <- if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
Risks(IC)$asCov else Risks(IC)$asCov$value
}else{
-##-t-## syt <- system.time({
getRiskICasVarArgs <- c(list(IC, risk = asCov(), withCheck = FALSE),E.argList)
riskAsVar <- do.call(getRiskIC, getRiskICasVarArgs)
asVar <- riskAsVar$asCov$value
-##-t-## })
+ sytm <- .addTime(sytm,"getRiskIC-Var")
}
-##-t-## sytm <- .addTime(sytm,syt,"getRiskIC-Var")
}else asVar <- var0
# print(asVar)
@@ -497,11 +433,9 @@
}else{
if(is(IC, "HampIC")){
r <- neighborRadius(IC)
-##-t-## syt <- system.time({
asBias <- r*getRiskIC(IC, risk = asBias(),
neighbor = neighbor(IC), withCheck = FALSE)$asBias$value
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,"getRiskIC-Bias")
+ sytm <- .addTime(sytm,"getRiskIC-Bias")
}else{
asBias <- NULL
}
@@ -526,7 +460,6 @@
IC <- .fixInLiesInSupport(IC, distribution(L2Fam))
-##-t-## syt <- system.time({
estres <- new("kStepEstimate", estimate.call = es.call,
name = paste(steps, "-step estimate", sep = ""),
estimate = theta, samplesize = nrow(x0), asvar = asVar,
@@ -536,13 +469,10 @@
steps = steps, Infos = Infos, start = start,
startval = start.val, ustartval = u.start.val, ksteps = ksteps,
uksteps = uksteps, pICList = pICList, ICList = ICList)
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,"new('kStepEstimate'...")
-##-t-## syt <- system.time({
+ sytm <- .addTime(sytm,"new('kStepEstimate'...")
estres <- .checkEstClassForParamFamily(L2Fam,estres)
-##-t-## })
-##-t-## sytm <- .addTime(sytm,syt,".checkEstClassForParamFamily")
-##-t-## attr(estres,"timings") <- sytm
+
+ attr(estres,"timings") <- apply(sytm,2,diff)
return(estres)
}
Modified: branches/robast-1.2/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/inst/NEWS 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/inst/NEWS 2018-08-15 20:40:56 UTC (rev 1143)
@@ -73,8 +73,12 @@
+ for time checking use file TimingChecks.R (with the preparation that
the lines commented out by ##-t-## in kStepEstimator.R have to be activated;
this uses helper function .addTime to produce a matrix with detailed timing
- information which can be read out as argument ) -- it is in package
- system folder "chkTimeCode" (in inst/chkTimeCode in r-forge)
+ information which can be read out as argument )
++ for time checking in kStepEstimator, the preliminary solution with timings
+ to be commented (special comments ##-t-##) in and out has been replaced by
+ permanent calls to proc.time(); this way we avoid creating new environments
+ (which is time-consuming!) through functions calls to system.time.
+ helper function .addTime has been adapted accordingly
+ now specified that we want to use distr::solve
+ now generateIC.fct produces vectorized functions (can now use useApply=FALSE in E())
+ checkIC and makeIC now both use helper function .preparedirectCheckMakeIC
@@ -82,13 +86,11 @@
useApply = FALSE to gain speed (code has moved from file IC.R to file CheckMakeIC.R)
+ several methods (getRiskIC, getBiasIC, getBoundedIC, makeIC, checkIC, modifyIC)
gain argument "..." to pass on arguments to E()
-+ new internal constant ..IntegrateArgs which contains the names of all arguments
- used for integration, i.e., currently, c("lowerTruncQuantile", "upperTruncQuantile",
- "IQR.fac", "subdivisions", "rel.tol", "abs.tol", "stop.on.error", "order", "useApply")
- this is used to filter out arguments from dots which are meant for E()
- by means of exported helper function .filterEargs(); in addition, .filterEargs()
- also checks if an argument "E.argList" is hidden in "..." and if so, filters in
- its entries (and in case of collision overwrites existing entries).
++ .filterEargs from distrEx is used to filter out arguments from dots which are
+ meant for E(); this is extended in RobAStBase::.filterEargsWEargList():
+ .filterEargsWEargList() also checks if an argument "E.argList" is hidden
+ in "..." and if so, filters in its entries (and in case of collision
+ overwrites existing entries).
+ getboundedIC now uses coordinate-wise integration with useApply = FALSE and
only computing the upper half of E LL'w
Modified: branches/robast-1.2/pkg/RobAStBase/man/internals.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/internals.Rd 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/man/internals.Rd 2018-08-15 20:40:56 UTC (rev 1143)
@@ -4,7 +4,6 @@
\alias{.getDistr}
\alias{.msapply}
\alias{.fixInLiesInSupport}
-\alias{..IntegrateArgs}
\title{Internal / Helper functions of package RobAStBase}
@@ -17,8 +16,7 @@
.evalListRec(list0)
.msapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE)
.fixInLiesInSupport(IC, distr)
-..IntegrateArgs
-.filterEargs(dots)
+.filterEargsWEargList(dots)
}
\arguments{
\item{x}{a (numeric) vector}
@@ -49,11 +47,13 @@
the influence curve (IC), whether the arguments at which the IC is to be evaluated lie
in the support of the distribution and accordingly either returns the function value
of the IC, or \code{0}; the check is done via calling \code{\link[distr]{liesInSupport}}.
-\code{..IntegrateArgs} is an internal constant, containing the names of all arguments
- used for integration, i.e., currently, \code{c("lowerTruncQuantile", "upperTruncQuantile",
- "IQR.fac", "subdivisions", "rel.tol", "abs.tol", "stop.on.error", "order", "useApply")}.
-\code{.filterEargs} filters out of \code{dots} all named arguments which have names
- contained in \code{..IntegrateArgs} and returns a list with these items.
+\code{.filterEargsWEargList} calls \code{distrEx::.filterEargs} to filter out of \code{dots}
+all relevant arguments for the integrators, \code{integrate}, \code{GLIntegrate},
+and \code{distrExIntegrate}; in addition, \code{.filterEargsWEargList}
+checks if an argument "E.argList" is hidden in the \code{dots} argument
+and if so, filters in its entries; in case of collisions with entries filtered
+from \code{distrEx::.filterEargs}, it overwrites existing entries. In the
+end it returns a list with the filtered items.
}
Modified: branches/robast-1.2/pkg/RobAStBase/man/kStepEstimator.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/kStepEstimator.Rd 2018-08-15 17:50:33 UTC (rev 1142)
+++ branches/robast-1.2/pkg/RobAStBase/man/kStepEstimator.Rd 2018-08-15 20:40:56 UTC (rev 1143)
@@ -79,6 +79,9 @@
used to re-compute the IC for a different parameter), the
computation of \code{asvar}, \code{asbias} and \code{IC} is
based on the k-step estimate.
+
+ Timings for the several substeps are available as attribute
+ \code{timings} of the return value.
}
\value{Object of class \code{"kStepEstimate"}.}
@@ -112,6 +115,7 @@
ksteps(est1)
pICList(est1)
start(est1)
+attr(est1,"timings")
## a transformed model
tfct <- function(x){
More information about the Robast-commits
mailing list