[Robast-commits] r1150 - in branches/robast-1.2/pkg/ROptEst: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 16 13:21:12 CEST 2018
Author: ruckdeschel
Date: 2018-08-16 13:21:12 +0200 (Thu, 16 Aug 2018)
New Revision: 1150
Modified:
branches/robast-1.2/pkg/ROptEst/R/CheckMakeContIC.R
branches/robast-1.2/pkg/ROptEst/inst/NEWS
branches/robast-1.2/pkg/ROptEst/man/checkmakeIC.Rd
Log:
[ROptEst] branch 1.2:
+ the particular checkIC and makeIC methods gain argument diagnostic to be able to
show diagnostic information on integrations
Modified: branches/robast-1.2/pkg/ROptEst/R/CheckMakeContIC.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/CheckMakeContIC.R 2018-08-16 11:16:09 UTC (rev 1149)
+++ branches/robast-1.2/pkg/ROptEst/R/CheckMakeContIC.R 2018-08-16 11:21:12 UTC (rev 1150)
@@ -2,13 +2,13 @@
## faster check for ContICs
setMethod("checkIC", signature(IC = "ContIC", L2Fam = "L2ParamFamily"),
- function(IC, L2Fam, out = TRUE, forceContICMethod = FALSE, ...){
+ function(IC, L2Fam, out = TRUE, forceContICMethod = FALSE, ..., diagnostic = FALSE){
D1 <- L2Fam at distribution
if( dimension(Domain(IC at Curve[[1]])) != dimension(img(D1)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
- res <- .prepareCheckMakeIC(L2Fam, w = IC at weight, forceContICMethod, ...)
+ res <- .prepareCheckMakeIC(L2Fam, w = IC at weight, forceContICMethod, ..., diagnostic = diagnostic)
## if it pays off to use symmetry/ to compute integrals in L2deriv space
## we compute the following integrals:
## G1 = E w, G2 = E Lambda w, G3 = E Lambda Lambda' w
@@ -20,7 +20,7 @@
if(is.null(res))
return(getMethod("checkIC", signature(IC = "IC",
- L2Fam = "L2ParamFamily"))(IC,L2Fam, out = out, ...))
+ L2Fam = "L2ParamFamily"))(IC,L2Fam, out = out, ..., diagnostic = diagnostic))
A <- stand(IC); a <- cent(IC)
@@ -37,6 +37,12 @@
print(Delta2)
cat("precision of Fisher consistency - relative error [%]:\n")
print(100*Delta2/trafo)
+
+ if(diagnostic){
+ print(attr(res$G1, "diagnostic"))
+ print(attr(res$G2, "diagnostic"))
+ print(attr(res$G3, "diagnostic"))
+ }
}
prec <- max(abs(Delta1), abs(Delta2))
@@ -47,7 +53,7 @@
## make some L2function a pIC at a model
setMethod("makeIC", signature(IC = "ContIC", L2Fam = "L2ParamFamily"),
- function(IC, L2Fam, forceContICMethod = FALSE, ...){
+ function(IC, L2Fam, forceContICMethod = FALSE, ..., diagnostic = FALSE){
D1 <- L2Fam at distribution
if( dimension(Domain(IC at Curve[[1]])) != dimension(img(D1)))
@@ -57,8 +63,14 @@
if(dimension(IC at Curve) != dims)
stop("Dimension of IC and parameter must be equal")
- res <- .prepareCheckMakeIC(L2Fam, w = IC at weight, forceContICMethod, ...)
+ res <- .prepareCheckMakeIC(L2Fam, w = IC at weight, forceContICMethod, ..., diagnostic = diagnostic)
+ if(diagnostic &&!is.null(res)){
+ print(attr(res$G1, "diagnostic"))
+ print(attr(res$G2, "diagnostic"))
+ print(attr(res$G3, "diagnostic"))
+ }
+
## if it pays off to use symmetry/ to compute integrals in L2deriv space
## we compute the following integrals:
## G1 = E w, G2 = E Lambda w, G3 = E Lambda Lambda' w
@@ -70,7 +82,7 @@
if(is.null(res))
return(getMethod("makeIC", signature(IC = "IC",
- L2Fam = "L2ParamFamily"))(IC,L2Fam,...))
+ L2Fam = "L2ParamFamily"))(IC,L2Fam,..., diagnostic = diagnostic))
G1 <- res$G1; G2 <- res$G2; G3 <- res$G3
trafO <- trafo(L2Fam at param)
@@ -116,7 +128,7 @@
return(cIC1)
})
-.prepareCheckMakeIC <- function(L2Fam, w, forceContICMethod, ...){
+.prepareCheckMakeIC <- function(L2Fam, w, forceContICMethod, ..., diagnostic = FALSE){
dims <- length(L2Fam at param)
trafo <- trafo(L2Fam at param)
@@ -145,15 +157,16 @@
res <- .getG1G2G3Stand(L2deriv = L2deriv, Distr = L2Fam at distribution,
- A.comp = A.comp, z.comp = z.comp, w = w, ...)
+ A.comp = A.comp, z.comp = z.comp, w = w, ...,
+ diagnostic = diagnostic)
return(res)
}
-.getG1G2G3Stand <- function(L2deriv, Distr, A.comp, z.comp, w, ...){
+.getG1G2G3Stand <- function(L2deriv, Distr, A.comp, z.comp, w, ..., diagnostic = FALSE){
- dotsI <- .filterEargsWEargList(list(...))
+ dotsI <- .filterEargs(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
w.fct <- function(x){
@@ -165,21 +178,25 @@
return(L2.i(x)*w.fct(x))
}
+ diagn <- if(diagnostic) vector("list", sum(z.comp)+sum(A.comp))
+ if(diagnostic) dotsI$diagnostic <- TRUE
Eargs <- c(list(object = Distr, fun = w.fct), dotsI)
res1 <- do.call(E,Eargs)
+ k <- 0
nrvalues <- length(L2deriv)
res2 <- numeric(nrvalues)
for(i in 1:nrvalues){
if(z.comp[i]){
Eargs <- c(list(object = Distr, fun = integrand2,
L2.i = L2deriv at Map[[i]]), dotsI)
- res2[i] <- do.call(E,Eargs)
+ res2[i] <- buf <- do.call(E,Eargs)
+ if(diagnostic){k <- k + 1; diagn[[k]] <- attr(buf,"diagnostic")}
}else{
res2[i] <- 0
}
}
-
+ if(diagnostic) {k1 <- k; attr(res2, "diagnostic") <- diagn[(1:k1)]}
cent <- res2/res1
integrandA <- function(x, L2.i, L2.j, i, j){
@@ -195,11 +212,13 @@
Eargs <- c(list(object = Distr, fun = integrandA,
L2.i = L2deriv at Map[[i]],
L2.j = L2deriv at Map[[j]], i = i, j = j), dotsI)
- erg[i, j] <- do.call(E,Eargs)
+ erg[i, j] <- buf <- do.call(E,Eargs)
+ if(diagnostic){k <- k + 1; diagn[[k]] <- attr(buf,"diagnostic")}
}
}
}
erg[col(erg) < row(erg)] <- t(erg)[col(erg) < row(erg)]
+ if(diagnostic) {k1 <- k; attr(erg, "diagnostic") <- diagn[-(1:k1)]}
return(list(G1=res1,G2=res2, G3=erg))
}
Modified: branches/robast-1.2/pkg/ROptEst/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/ROptEst/inst/NEWS 2018-08-16 11:16:09 UTC (rev 1149)
+++ branches/robast-1.2/pkg/ROptEst/inst/NEWS 2018-08-16 11:21:12 UTC (rev 1150)
@@ -52,7 +52,7 @@
+ clarified if clauses in roptest.new (and removed .with.checkEstClassForParamFamily from dots to be sure)
+ inserted code for time checking (which is inactive usually; only if in kStepEstimator.R in
RobAStBase, the respective ##-t-## lines are de-commented the timings are visible as
- attribute "kStepTimings" in the result of roptest ...)
+ attribute "kStepTimings" in the result of roptest ...) changed now: is always active....
+ now specified that we want to use distr::solve
+ internal function .getComp, determining by symmetry slots which entries in LMs a and A
have to be computed, now fills the lower triangle of A with FALSE (was not used so far,
@@ -75,6 +75,8 @@
does checking / the affine transformation to give the proper pIC. These methods by
default are only used if it pays off, i.e., if the number of computed integrals is smaller
than in the default method. This can be overriden by argument forceContICMethod.
++ the particular checkIC and makeIC methods gain argument diagnostic to be able to
+ show diagnostic information on integrations
#######################################
version 1.1
Modified: branches/robast-1.2/pkg/ROptEst/man/checkmakeIC.Rd
===================================================================
--- branches/robast-1.2/pkg/ROptEst/man/checkmakeIC.Rd 2018-08-16 11:16:09 UTC (rev 1149)
+++ branches/robast-1.2/pkg/ROptEst/man/checkmakeIC.Rd 2018-08-16 11:21:12 UTC (rev 1150)
@@ -12,9 +12,9 @@
}
\usage{
\S4method{checkIC}{ContIC,L2ParamFamily}(IC, L2Fam, out = TRUE,
- forceContICMethod = FALSE, ...)
+ forceContICMethod = FALSE, ..., diagnostic = FALSE)
\S4method{makeIC}{ContIC,L2ParamFamily}(IC, L2Fam,
- forceContICMethod = FALSE, ...)
+ forceContICMethod = FALSE, ..., diagnostic = FALSE)
}
\arguments{
\item{IC}{ object of class \code{"IC"} }
@@ -39,6 +39,9 @@
slot \code{param} of \code{L2Fam}.}
\item{\dots}{ additional parameters to be passed on to expectation
\code{E}. }
+ \item{diagnostic}{ logical; if \code{TRUE} (and in case \code{checkIC} if
+ argument \code{out==TRUE}), diagnostic information on the integration
+ is printed. }
}
\details{
In \code{checkIC}, the precisions of the centering and the Fisher consistency
More information about the Robast-commits
mailing list