[Distr-commits] r1278 - in branches/distr-2.8/pkg/distrMod: . R inst man tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 15 21:58:22 CEST 2018
Author: ruckdeschel
Date: 2018-08-15 21:58:21 +0200 (Wed, 15 Aug 2018)
New Revision: 1278
Modified:
branches/distr-2.8/pkg/distrMod/NAMESPACE
branches/distr-2.8/pkg/distrMod/R/AllPlot.R
branches/distr-2.8/pkg/distrMod/R/Expectation.R
branches/distr-2.8/pkg/distrMod/R/asCvMVarianceQtl.R
branches/distr-2.8/pkg/distrMod/inst/NEWS
branches/distr-2.8/pkg/distrMod/man/internals.Rd
branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
Log:
[distrMod] branch 2.8
+ plot signature(x = "L2ParamFamily", y = "missing") allows for width and height to be given (then applied in devNew(...)
+ E() methods with signature(object = "L2ParamFamily" , ...) gain argument diagnostic and use filtering of dots arguments
(like E()-methods in distrEx v 2.8.0)
+ similarly the asCvMVarianceQtl.R
Modified: branches/distr-2.8/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.8/pkg/distrMod/NAMESPACE 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/NAMESPACE 2018-08-15 19:58:21 UTC (rev 1278)
@@ -4,7 +4,7 @@
"points", "text", "title")
importFrom("stats", "aggregate", "approxfun", "complete.cases",
"dbinom", "dnbinom", "dnorm", "dpois", "na.omit", "optim",
- "optimize", "ppoints", "qchisq", "qnbinom", "qnorm")
+ "optimize", "ppoints", "qchisq", "qnbinom", "qnorm", "quantile")
import("MASS")
import("distr")
import("distrEx")
Modified: branches/distr-2.8/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/AllPlot.R 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/R/AllPlot.R 2018-08-15 19:58:21 UTC (rev 1278)
@@ -255,9 +255,12 @@
# opar$cin <- opar$cra <- opar$csi <- opar$cxy <- opar$din <- NULL
on.exit(par(opar, no.readonly = TRUE))
- if (!withSweave)
- devNew()
-
+ if (!withSweave){
+ devNewArgs <- list()
+ if(!is.null(dots$width)) devNewArgs[["width"]] <- dots[["width"]]
+ if(!is.null(dots$height)) devNewArgs[["height"]] <- dots[["height"]]
+ do.call(devNew, devNewArgs)
+ }
parArgs <- NULL
if(mfColRow)
parArgs <- list(mfrow = c(nrows, ncols))
Modified: branches/distr-2.8/pkg/distrMod/R/Expectation.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/Expectation.R 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/R/Expectation.R 2018-08-15 19:58:21 UTC (rev 1278)
@@ -2,24 +2,38 @@
setMethod("E", signature(object = "L2ParamFamily",
fun = "EuclRandVariable",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- return(E(object = object at distribution, fun = fun, useApply = useApply, ...))
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ return(E(object = object at distribution, fun = fun, useApply = useApply, ..., diagnostic = diagnostic))
})
setMethod("E", signature(object = "L2ParamFamily",
fun = "EuclRandMatrix",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- matrix(E(object = object, fun = as(fun, "EuclRandVariable"),
- useApply = useApply, ...), nrow = nrow(fun))
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ res <- E(object = object, fun = as(fun, "EuclRandVariable"),
+ useApply = useApply, ...)
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ }
+ res <- matrix(res, nrow = nrow(fun))
+ if(diagnostic) attr(res, "diagnostic") <- diagn
+ return(res)
})
setMethod("E", signature(object = "L2ParamFamily",
fun = "EuclRandVarList",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
nrvalues <- length(fun)
res <- vector("list", nrvalues)
- for(i in 1:nrvalues) res[[i]] <- E(object = object, fun = fun[[i]],
- useApply = useApply, ...)
-
+ diagn <- if(diagnostic) vector("list",nrvalues) else NULL
+ for(i in 1:nrvalues){
+ res[[i]] <- buf <- E(object = object, fun = fun[[i]],
+ useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn[[i]] <- attr(buf,"diagnostic")
+ }
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ }
return(res)
})
Modified: branches/distr-2.8/pkg/distrMod/R/asCvMVarianceQtl.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/asCvMVarianceQtl.R 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/R/asCvMVarianceQtl.R 2018-08-15 19:58:21 UTC (rev 1278)
@@ -24,17 +24,21 @@
N = 1021, rel.tol=.Machine$double.eps^0.3,
TruncQuantile = getdistrOption("TruncQuantile"),
IQR.fac = 15,
- ...){
+ ..., diagnostic = FALSE){
# preparations:
+ dots <- list(...)
- dotsInt <- list(...)
+ dotsInt <- .filterEargs(dots)
dotsInt[["f"]] <- NULL
dotsInt[["lower"]] <- NULL
dotsInt[["upper"]] <- NULL
dotsInt[["stop.on.error"]] <- NULL
dotsInt[["distr"]] <- NULL
+ dotsInt[["diagnostic"]] <- NULL
+ dotsInt[["useApply"]] <- NULL
+
.useApply <- FALSE
- if(!is.null(dotsInt$useApply)) .useApply <- dotsInt$useApply
+ if(!is.null(dots$useApply)) .useApply <- dots$useApply
if(missing(TruncQuantile)||TruncQuantile>1e-7) TruncQuantile <- 1e-8
@@ -59,6 +63,7 @@
paramP at trafo <- diag(dim0)
L2Fam <- modifyModel(L2Fam, paramP)
+ diagn <- if(diagnostic) list(call=match.call()) else NULL
distr <- L2Fam at distribution
### get a sensible integration range:
@@ -136,9 +141,12 @@
onedim <- (length(L2deriv.0 at Map)==1)
- myint <- function(f,...){
- distrExIntegrate(f=f, lower=0, upper=1,
- stop.on.error=FALSE, distr=Unif(), ...)
+ myint <- function(f,...,diagnostic0 = FALSE){
+ dotsFun <- .filterFunargs(dots,f)
+ fwD <- function(x) do.call(f, c(list(x),dotsFun))
+ do.call(distrExIntegrate, c(list(f=fwD, lower=0, upper=1,
+ stop.on.error=FALSE, distr=Unif(), diagnostic=diagnostic0,
+ dotsInt)))
}
if(onedim){
@@ -159,9 +167,11 @@
Delta0.3 <- rev(Delta0.2)[1]+h0/100*.csimpsum(Delta0x.3)
Delta0 <- c(Delta0.1,Delta0.2,Delta0.3)
Delta1.q <- approxfun(x.seq.a, Delta0, yleft = 0, yright = 0)
- J1 <- do.call(myint, c(list(f=Delta1.q), dotsInt))
+ J1 <- myint(f=Delta1.q, diagnostic0=diagnostic)
+ if(diagnostic) diagn$J1 <- attr(J1,"diagnostic")
Delta.0 <- function(x) Delta1.q(p(distr)(x))-J1
- J <- do.call(myint, c(list(f=function(x) (Delta1.q(x)-J1)^2),dotsInt))
+ J <- myint(f=function(x) (Delta1.q(x)-J1)^2, diagnostic0=diagnostic)
+ if(diagnostic) diagn$J <- attr(J,"diagnostic")
}else{
if(is(distr,"DiscreteDistribution")){
L2x <- evalRandVar(L2deriv.0, as.matrix(x.seq))[,,1]
@@ -174,13 +184,25 @@
Delta <- Delta/J
}else{
L2x <- function(x,y) (x<=y)*evalRandVar(L2deriv.0, as.matrix(x))[,,1]
- Delta0 <- sapply(x.seq, function(Y){ fct <- function(x) L2x(x,y=Y)
- return(E(object=distr, fun = fct, useApply = .useApply))})
+ diagn0 <- list()
+ xseq.i <- quantile(seq(x.seq),c(0,0.25,.5,.75,1))
+ Delta0 <- sapply(seq(x.seq), function(Y){
+ res <- do.call(E, c(list(object=distr,
+ fun = function(x) L2x(x,y=x.seq[Y]),
+ useApply = .useApply,
+ diagnostic=diagnostic),dotsInt))
+ if(diagnostic) if(Y %in% xseq.i) diagn0[[paste(Y)]] <<- attr(res,"diagnostic")
+ })
+ if(diagnostic) diagn$Delta0 <- diagn0
Delta1 <- approxfun(x.seq, Delta0, yleft = 0, yright = 0)
Delta <- Delta1
- J1 <- E(object=distr, fun = Delta, useApply = .useApply)
+ J1 <- do.call(E, c(list(object=distr, fun = Delta, useApply = .useApply,
+ diagnostic=diagnostic), dotsInt))
+ if(diagnostic) diagn$J1 <- attr(J1,"diagnostic")
Delta.0 <- function(x) Delta(x) - J1
- J <- E(object=distr, fun = function(x) Delta.0(x)^2, useApply = .useApply )
+ J <- do.call(E, c(list(object=distr, fun = function(x) Delta.0(x)^2, useApply = .useApply,
+ diagnostic=diagnostic), dotsInt))
+ if(diagnostic) diagn$J <- attr(J,"diagnostic")
}
}
@@ -193,7 +215,8 @@
## integrand phi x Ptheta in formula (51) [ibid]
phi1.q <- function(s){qs <- q.l(mu)(s)
return(phi(qs)*p(distr)(qs)) }
- psi1 <- do.call(myint, c(list(f=phi1.q),dotsInt))
+ psi1 <- myint(f=phi1.q, diagnostic0=diagnostic)
+ if(diagnostic) diagn$psi1 <- attr(psi1,"diagnostic")
phiqx <- function(x){qx <- q.l(mu)(x)
return(phi(qx))}
@@ -223,11 +246,21 @@
}else{
## integrand phi x Ptheta in formula (51) [ibid]
phi1 <- function(x) phi(x) * p(distr)(x)
- psi1 <- E(object = mu, fun = phi1, useApply = .useApply)
+ psi1 <- do.call(E,c(list(object = mu, fun = phi1, useApply = .useApply,
+ diagnostic = diagnostic),dotsInt))
+ if(diagnostic) diagn$psi1 <- attr(psi1,"diagnostic")
phixy <- function(x,y) (x<=y)*phi(y)
- psi0 <- sapply(x.mu.seq, function(X){ fct <- function(y) phixy(x=X,y=y)
- return(E(object=mu, fun = fct, useApply = .useApply))})
+ diagn1 <- list()
+ x.mu.seq.i <- quantile(seq(x.mu.seq),c(0,0.25,.5,.75,1))
+ psi0 <- sapply(seq(x.mu.seq), function(X){
+ fct <- function(y) phixy(x=x.mu.seq[X],y=y)
+ res <- do.call(E,c(list(object=mu, fun = fct,
+ useApply = .useApply), dotsInt))
+ if(diagnostic) if(X %in% x.mu.seq.i)
+ diagn1[[paste(X)]] <<- attr(res,"diagnostic")
+ return(res)})
+
psi.1 <- approxfun(x.mu.seq, psi0, yleft = 0, yright = rev(psi0)[1])
psi.fct <- function(x) psi.1(x)-psi1
}
@@ -237,14 +270,17 @@
psi.q <- function(x){qx <- q.l(distr)(x); return(psi.fct(qx))}
## E2 = Cov_mu (psi)
# E2 <- do.call(myint, c(list(f=function(x)psi.q(x)^2),dotsInt))
- E1 <- do.call(myint, c(list(f=psi.q),dotsInt))
- E3 <- do.call(myint, c(list(f=function(x){
- qx <- q.l(distr)(x)
- L2qx <- evalRandVar(L2deriv.0,as.matrix(qx))[,,1]
- return(psi.fct(qx)*L2qx)
- }), dotsInt))
+ E1 <- myint(f=psi.q, diagnostic0=diagnostic)
+ if(diagnostic) diagn$E1 <- attr(E1,"diagnostic")
+ E3 <- myint(f=function(x){
+ qx <- q.l(distr)(x)
+ L2qx <- evalRandVar(L2deriv.0,as.matrix(qx))[,,1]
+ return(psi.fct(qx)*L2qx)
+ }, diagnostic0=diagnostic)
+ if(diagnostic) diagn$E3 <- attr(E3,"diagnostic")
psi.01.f <- function(x) (psi.fct(x)-E1)/E3
- E4 <- do.call(myint, c(list(f=function(x) (psi.q(x)-E1)^2/E3^2),dotsInt))
+ E4 <- myint(f=function(x) (psi.q(x)-E1)^2/E3^2, diagnostic0=diagnostic)
+ if(diagnostic) diagn$E4 <- attr(E4,"diagnostic")
}else{
if(is(distr,"DiscreteDistribution")){
## E2 = Cov_mu (psi)
@@ -259,17 +295,23 @@
## E2 = Cov_mu (psi)
# E2 <- E(object=distr, fun = function(x) psi(x)^2, useApply = .useApply)
L2x <- function(x,y) (x<=y)*evalRandVar(L2deriv.0, as.matrix(x))[,,1]
- E1 <- E(object=distr, fun = psi.fct, useApply = .useApply )
- E3 <- E(object=distr, fun = function(x)
- psi.fct(x)*evalRandVar(L2deriv.0, as.matrix(x))[,,1], useApply = .useApply)
+ E1 <- do.call(E, c(list(object=distr, fun = psi.fct,
+ useApply = .useApply, diagnostic=diagnostic), dotsInt))
+ if(diagnostic) diagn$E1 <- attr(E1,"diagnostic")
+ E3 <- do.call(E, c(list(object=distr, fun = function(x)
+ psi.fct(x)*evalRandVar(L2deriv.0, as.matrix(x))[,,1],
+ diagnostic=diagnostic, useApply = .useApply),dotsInt))
+ if(diagnostic) diagn$E3 <- attr(E3,"diagnostic")
psi.01.f <- function(x) (psi.fct(x) - E1)/E3
- E4 <- E(object=distr, fun = function(x) psi.01.f(x)^2, useApply = .useApply)
+ E4 <- do.call(E, c(list(object=distr, fun = function(x) psi.01.f(x)^2,
+ diagnostic=diagnostic, useApply = .useApply),dotsInt))
+ if(diagnostic) diagn$E4 <- attr(E4,"diagnostic")
}
}
# ### control: centering & standardization
if(withplot)
- { dev.new() #windows()
+ { devNew() #windows()
x0.seq <- x.seq
if(is(distr,"AbscontDistribution")) x0.seq <- q.l(distr)(x.seq)
plot(x0.seq, psi.01.f(x0.seq),
@@ -289,6 +331,11 @@
## Ptheta- primitive function for Lambda
Map.Delta <- vector("list",Dim)
+ if(diagnostic) diagn <- list()
+ if(!is(distr,"AbscontDistribution") &&
+ !is(distr,"DiscreteDistribution") ) diagn$Delta0 <- vector("list",Dim)
+ if(!is(mu,"AbscontDistribution") &&
+ !is(mu,"DiscreteDistribution") ) diagn$phi0 <- vector("list",Dim)
for(i in 1:Dim)
{ if(is(distr,"AbscontDistribution")){
@@ -317,8 +364,18 @@
assign("Delta.0", Delta.0, envir=env.i)
}else{
fct0 <- function(x,y) L2deriv.0 at Map[[i]](x)*(x<=y)
- Delta0 <- sapply(x.seq, function(Y){ fct <- function(x) fct0(x,y=Y)
- return(E(object=distr, fun = fct, useApply=.useApply))})
+ diagn0 <- list()
+ xseq.i <- quantile(seq(x.seq),c(0,0.25,.5,.75,1))
+ Delta0 <- sapply(seq(x.seq),
+ function(Y){
+ fct <- function(x) fct0(x,y=x.seq[Y])
+ res <- do.call(E,c(list(object=distr, fun = fct,
+ useApply=.useApply),dotsInt))
+ if(diagnostic) if(Y %in% xseq.i)
+ diagn0[[paste(Y)]] <<- attr(res,"diagnostic")
+ return(res)
+ })
+ if(diagnostic) diagn[["Delta0"]][[i]] <- diagn0
Delta1 <- approxfun(x.seq, Delta0, yleft = 0, yright = 0)
if(is(distr,"DiscreteDistribution"))
Delta <- function(x) Delta1(x) * (x %in% support(distr))
@@ -350,12 +407,14 @@
## J = Var_Ptheta Delta
##-t-## print(system.time({
- J1 <- E(object=distr, fun = Delta)#, useApply = .useApply)
+ J1 <- E(object=distr, fun = Delta, diagnostic=diagnostic)#, useApply = .useApply)
+ if(diagnostic) diagn$J1 <- attr(J1,"diagnostic")
##-t-## }))
Delta.0 <- Delta - J1
##-t-## print(system.time({
- J <- E(object=distr, fun = Delta.0 %*%t(Delta.0))#, useApply = .useApply)
+ J <- E(object=distr, fun = Delta.0 %*%t(Delta.0), diagnostic=diagnostic)#, useApply = .useApply)
+ if(diagnostic) diagn$J <- attr(J,"diagnostic")
##-t-## }))
### CvM-IC phi
phi <- as(distr::solve(J)%*%Delta.0,"EuclRandVariable")
@@ -371,7 +430,8 @@
phi1 <- EuclRandVariable(Map = Map.phi1, Domain = Reals())
##-t-## print(system.time({
- psi1 <- E(object=mu, fun = phi1)#, useApply = .useApply)
+ psi1 <- E(object=mu, fun = phi1, diagnostic=diagnostic)#, useApply = .useApply)
+ if(diagnostic) diagn$psi1 <- attr(psi1,"diagnostic")
##-t-## }))
## obtaining IC psi (formula (51))
@@ -414,12 +474,21 @@
assign("psi0.d", psi0.d, envir=env.i)
assign("psi0", psi0, envir=env.i)
}else{
+
fct0 <- function(x,y) evalRandVar(phi, as.matrix(y))[i,,1]*(x<=y)
- phi0 <- sapply(x.mu.seq,
- function(X){
- fct <- function(y) fct0(x = X, y)
- return(E(object = mu, fun = fct, useApply = .useApply))
- })
+ diagn1 <- list()
+ x.mu.seq.i <- quantile(seq(x.mu.seq),c(0,0.25,.5,.75,1))
+ phi0 <- sapply(seq(x.mu.seq),
+ function(X){
+ fct <- function(y) fct0(x=x.mu.seq[X],y)
+ res <- do.call(E,c(list(object=mu, fun = fct,
+ useApply=.useApply),dotsInt))
+ if(diagnostic) if(X %in% x.mu.seq.i)
+ diagn1[[paste(X)]] <<- attr(res,"diagnostic")
+ return(res)
+ })
+ if(diagnostic) diagn[["phi0"]][[i]] <- diagn1
+
phi0a <- approxfun(x.mu.seq, phi0, yleft = 0, yright = rev(phi0)[1])
if(is(distr,"DiscreteDistribution"))
psi0 <- function(x) phi0a(x) * (x %in% support(mu))
@@ -447,10 +516,13 @@
### control: centering & standardization
L2deriv.0 <- L2Fam at L2deriv[[1]]
##-t-## print(system.time({
- E1 <- E(object=distr, fun = psi)
+ E1 <- E(object=distr, fun = psi, diagnostic=diagnostic)
+ if(diagnostic) diagn$E1 <- attr(E1,"diagnostic")
+
##-t-## }))
##-t-## print(system.time({
- E3 <- E(object=distr, fun = psi %*%t(L2deriv.0))
+ E3 <- E(object=distr, fun = psi %*%t(L2deriv.0), diagnostic=diagnostic)
+ if(diagnostic) diagn$E3 <- attr(E3,"diagnostic")
##-t-## }))
psi.0 <- psi - E1
psi.01 <- as(distr::solve(E3)%*%psi.0,"EuclRandVariable")
@@ -463,7 +535,8 @@
type = if(is(distr,"DiscreteDistribution")) "p" else "l")
}}
##-t-## print(system.time({
- E4 <- E(object=distr, fun = psi.01 %*%t(psi.01))
+ E4 <- E(object=distr, fun = psi.01 %*%t(psi.01), diagnostic=diagnostic)
+ if(diagnostic) diagn$E4 <- attr(E4,"diagnostic")
##-t-## }))
}
E4 <- PosSemDefSymmMatrix(E4)
@@ -493,7 +566,8 @@
}
nms <- names(c(main(param(L2Fam)),nuisance(param(L2Fam))))
dimnames(E4) = list(nms,nms)
- if(withpreIC) return(list(preIC=psi, Var=E4))
+ if(diagnostic &&! withpreIC) attr(E4,"diagnostic") <- diagn
+ if(withpreIC) return(list(preIC=psi, Var=E4, diagnostic = diagn))
else return(E4)
}
@@ -779,7 +853,7 @@
psi.01 <- as(distr::solve(E3)%*%psi.0,"EuclRandVariable")
if(withplot)
{ for(i in 1:Dim)
- { dev.new()
+ { devNew()
plot(x.mu.seq, sapply(x.mu.seq,psi.01 at Map[[i]]),
type = if(is(distr,"DiscreteDistribution")) "p" else "l")
}}
Modified: branches/distr-2.8/pkg/distrMod/inst/NEWS
===================================================================
--- branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-08-15 19:58:21 UTC (rev 1278)
@@ -40,6 +40,10 @@
of the numerically truncated support).
+ new model classes / generators LogisticLocationScaleFamily, CauchyLocationFamily
+ changed default for CvMMDEstiamtor to variant "Mod" (consistent to fitdistrplus)
++ more precise / explicit description of the requirements of slots L2deriv and L2deriv.fct in
+ the help files to generator L2ParamFamily and to L2ParamFamily-class.
++ E() methods with signature(object = "L2ParamFamily" , ...) gain argument diagnostic
+ (like E()-methods in distrEx v 2.8.0)
bug fixes
+ discovered some issues with local variables in L2Families (global values were used instead...)
@@ -75,6 +79,11 @@
centering/standarizing of the IC in the end already cancelled out beforehand...
but now we are more accurate as to differences in the integration measure mu
and the model distribution (important for integration w.r.t. emp. measure)
+ the revised .CvMMDCovariance() uses vectorization in evaluation of random variables
+ and, wherever possible in integration; for the latter, this can be suppressed by
+ an argument useApply=TRUE through the ... argument
+ in addition .CvMMDCovariance() now has argument "diagnostic" (like E())
+ and in calls to E(), the "..." argument is filtered
+ .process.meCalcRes gains arg "x" to be able to pass on emp.CDF for mu in CvMMDEstimator
if arg asvar.fct of MCEstimator has "x" in formals the observations x are passed on to asvar.fct,
otherwise they are not; correspondingly "x" is passed on to .process.meCalcRes in
@@ -104,6 +113,8 @@
+ (robust) start parameters for Nbinom family with two parameters
+ (robust) start (search) parameters for Poisson family
+ now specified that we want to use distr::solve
++ E() methods with signature(object = "L2ParamFamily" , ...) use filtering of dots arguments
+ (like E()-methods in distrEx v 2.8.0)
##############
Modified: branches/distr-2.8/pkg/distrMod/man/internals.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/internals.Rd 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/man/internals.Rd 2018-08-15 19:58:21 UTC (rev 1278)
@@ -25,7 +25,7 @@
withplot = FALSE, withpreIC = FALSE,
N = 1021, rel.tol=.Machine$double.eps^0.3,
TruncQuantile = getdistrOption("TruncQuantile"),
- IQR.fac = 15, ...)
+ IQR.fac = 15, ..., diagnostic = FALSE)
.oldCvMMDCovariance(L2Fam, param, mu = distribution(L2Fam),
withplot = FALSE, withpreIC = FALSE,
N = getdistrOption("DefaultNrGridPoints")+1,
@@ -86,6 +86,15 @@
\code{dim} attribute; in \code{.CvMMDCovarianceWithMux}: \code{NULL}
(default) or the vector with observations to build integration
measure \eqn{mu} as the empirical cdf. }
+ \item{diagnostic}{ logical; if \code{TRUE}, the return value of \code{.CvMMDCovariance}
+ obtains an attribute \code{"diagnostic"} (usually a lengthy list)
+ with diagnostic information on the call and on the integration, the latter
+ inherited from the calls to \code{distrExIntegrate} and \code{E} in this function.
+ Depending on the actually used \code{E} method, this comprises entries
+ \code{method} (\code{"integrate"} or \code{"GLIntegrate"}),
+ \code{result} (the complete return value of the integration method),
+ \code{args} (the args with which the integration method was called),
+ and \code{time} (the time to compute the integral). }
}
\details{
Modified: branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
===================================================================
--- branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-08-15 14:08:10 UTC (rev 1277)
+++ branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-08-15 19:58:21 UTC (rev 1278)
@@ -93,7 +93,7 @@
IQR, mad, median, var
Loading required package: RandVar
-:RandVar> Implementation of Random Variables (version 1.1.0)
+:RandVar> Implementation of Random Variables (version 1.2.0)
:RandVar>
:RandVar> For more information see ?"RandVar", NEWS("RandVar"), as
:RandVar> well as
@@ -459,7 +459,7 @@
dimnames = list(nms, nms0))
list(fval = fval0, mat = mat0)
}
-<bytecode: 0x0e596b80>
+<bytecode: 0x0e0c24c8>
Trafo / derivative matrix at which estimate was produced:
scale shape
shape 0.000 1
@@ -675,7 +675,7 @@
1)/c(scale = 1)
return(y)
}
-<environment: 0x0ed32a30>
+<environment: 0x0e862ca0>
> checkL2deriv(E1)
precision of centering: -2.04266e-06
@@ -863,8 +863,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0f550478>
-<environment: 0x0f5502b8>
+<bytecode: 0x0f3eac18>
+<environment: 0x0f3eaa58>
>
> ## The function is currently defined as
@@ -1182,7 +1182,7 @@
1)/c(meanlog = 1)
return(y)
}
-<environment: 0x109f06e8>
+<environment: 0x0ccc67b0>
> checkL2deriv(L1)
precision of centering: -0.003003394
@@ -2290,7 +2290,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x0c5c3cf0>
+<bytecode: 0x0dd6b0a0>
<environment: namespace:distrMod>
> name(EuclNorm)
[1] "EuclideanNorm"
@@ -2325,7 +2325,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x0c5c3cf0>
+<bytecode: 0x0dd6b0a0>
<environment: namespace:distrMod>
>
@@ -2808,8 +2808,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A0)
-<bytecode: 0x0ab62598>
-<environment: 0x0ab61968>
+<bytecode: 0x0ad449a0>
+<environment: 0x0ad44ba0>
>
> ## The function is currently defined as
@@ -2850,8 +2850,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0a8f7558>
-<environment: 0x0a8f7838>
+<bytecode: 0x0ac8fb50>
+<environment: 0x0ac8ed80>
>
> ## The function is currently defined as
@@ -3977,7 +3977,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d7bc198>
+<bytecode: 0x0e17bbb0>
> print(param(NS), show.details = "minimal")
An object of class "ParamWithScaleFamParameter"
name: location and scale
@@ -4026,7 +4026,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d7bc198>
+<bytecode: 0x0e17bbb0>
Trafo / derivative matrix:
mean sd
mu/sig 0.3668695 -0.3024814
@@ -4069,7 +4069,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d7bc198>
+<bytecode: 0x0e17bbb0>
Trafo / derivative matrix:
mean sd
mu/sig 0.3669 -0.3025
@@ -4490,7 +4490,7 @@
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 33.45 0.5 33.98 NA NA
+Time elapsed: 52.66 0.75 55.35 NA NA
> grDevices::dev.off()
null device
1
More information about the Distr-commits
mailing list