[Distr-commits] r967 - in branches/distr-2.6/pkg/distrEllipse: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 5 16:03:56 CEST 2014
Author: ruckdeschel
Date: 2014-09-05 16:03:56 +0200 (Fri, 05 Sep 2014)
New Revision: 967
Modified:
branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R
branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R
branches/distr-2.6/pkg/distrEllipse/inst/NEWS
branches/distr-2.6/pkg/distrEllipse/man/EllipticalDistribution-class.Rd
branches/distr-2.6/pkg/distrEllipse/man/MultivarDistrList-class.Rd
branches/distr-2.6/pkg/distrEllipse/man/MultivarMixingDistribution-class.Rd
Log:
fixed issue with E and var methods for MultivarMixingDistributions
Modified: branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R 2014-09-05 14:03:56 UTC (rev 967)
@@ -130,6 +130,17 @@
## functionals:
setMethod("E", signature(object = "EllipticalDistribution",
+ fun = "function", cond = "missing"),
+ function(object,fun){
+ x <- r(object)(1e5)
+ fx1 <- fun(x[,1])
+ dfx <- dim(fx1)
+ ffun <- function(x) c(fun(x))
+ mfun <- rowMeans(apply(x,2,ffun))
+ if(is.null(dfx)) return(mfun)
+ return(array(mfun,dim=dfx))
+ })
+setMethod("E", signature(object = "EllipticalDistribution",
fun = "missing", cond = "missing"),
function(object,...) location(object))
setMethod("var", signature(x = "EllipticalDistribution"),
Modified: branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R 2014-09-05 14:03:56 UTC (rev 967)
@@ -10,8 +10,6 @@
ldots <- c(ldots, Dlist.L)
}
l <- length(ldots)
- print(ldots)
- print(ldots[[2]])
mixDistr <- do.call(MultivarDistrList,args=ldots)
if(is(mixDistr,"UnivarDistrList"))
return(UnivarMixingDistribution(Dlist = mixDistr, mixCoeff = mixCoeff))
@@ -125,38 +123,45 @@
})
}
+
setMethod("E", signature(object = "MultivarMixingDistribution",
- fun = "ANY", cond = "ANY"),
- function(object, fun, cond, ...) {
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
-
+ fun = "missing", cond = "missing"), function(object, ...) {
l <- length(object at mixCoeff)
- argL <- NULL
- if(!missing(fun)) argL <- list(fun=fun)
- if(!missing(cond)) argL <- c(argL, list(cond = cond))
- res <- object at mixCoeff[1]*do.call("E",
- args = c(list(object=object at mixDistr[[1]]),
- argL, dots))
- di <- dim(res)
- lres <- length(res)
- if(l>1){
- cdo <- if(lres >1) cbind else c
- res <- cdo(c(res), sapply(2:l, function(i)
- object at mixCoeff[i]*do.call("E",
- args = c(list(object=object at mixDistr[[i]]),
- argL, dots))))
+ res <- object at mixCoeff[1]*E(object=object at mixDistr[[1]], ...)
+ if(l==1) return(res)
+ for(i in 2:l){
+ res0 <- object at mixCoeff[i]*E(object=object at mixDistr[[i]], ...)
+ res <- res + res0
}
- if(!is.null(di))
- res <- array(res, dim=c(di,l))
- di <- dim(res)
-
- ldi <- if(length(di)>1) 1:(length(di)-1) else 1
- if(length(di) > 1)
- return(apply(res,ldi,sum))
- else return(sum(res))
+ return(res)
})
+setMethod("E", signature(object = "MultivarMixingDistribution",
+ fun = "function", cond = "missing"),
+ function(object, fun, ...) {
+ l <- length(object at mixCoeff)
+ res <- object at mixCoeff[1]*E(object=object at mixDistr[[1]], fun=fun,...)
+ if(l==1) return(res)
+ for(i in 2:l){
+ res0 <- object at mixCoeff[i]*E(object=object at mixDistr[[i]], fun=fun, ...)
+ res <- res + res0
+ }
+ return(res)
+ })
+setMethod("var", signature(x = "MultivarMixingDistribution"),
+ function(x,...){
+ l <- length(x at mixCoeff)
+ if(l==1L) return(var(x at mixDistr[[1]],...))
+ E1 <- E2 <- 0
+ for(i in 1:l){
+ E10 <- E(x at mixDistr[[i]], ...)
+ E1 <- E1 + x at mixCoeff[i]*E10
+ E2 <- E2 + (E10%*%t(E10)+var(x at mixDistr[[i]],...)) *
+ x at mixCoeff[i]
+ }
+ return(E2-E1%*%t(E1))})
+
+
setMethod("plot", signature(x = "MultivarMixingDistribution", y = "missing"),
function(x, Nsim = getdistrEllipseOption("Nsim"), ...,
withED = getdistrEllipseOption("withED"),
Modified: branches/distr-2.6/pkg/distrEllipse/inst/NEWS
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/inst/NEWS 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/inst/NEWS 2014-09-05 14:03:56 UTC (rev 967)
@@ -15,8 +15,8 @@
+ removed ::: internal dependencies (within distr-Fam of pkgs) by copying
respective routines
++ fixed E and var methods for MultivarMixingDistribution
-
##############
v 2.5
##############
Modified: branches/distr-2.6/pkg/distrEllipse/man/EllipticalDistribution-class.Rd
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/man/EllipticalDistribution-class.Rd 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/man/EllipticalDistribution-class.Rd 2014-09-05 14:03:56 UTC (rev 967)
@@ -6,6 +6,7 @@
\alias{scale<-,EllipticalDistribution-method}
\alias{location<-,EllipticalDistribution-method}
\alias{E,EllipticalDistribution,missing,missing-method}
+\alias{E,EllipticalDistribution,function,missing-method}
\alias{var,EllipticalDistribution-method}
\alias{+,EllipticalDistribution,numeric-method}
\alias{*,EllipticalDistribution,numeric-method}
@@ -84,6 +85,9 @@
\item{E}{\code{signature(object = "EllipticalDistribution", fun = "missing", cond = "missing")}:
expectation of an elliptically symmetric distribution; exact.
}
+ \item{E}{\code{signature(object = "EllipticalDistribution", fun = "function", cond = "missing")}:
+ expectation of an elliptically symmetric distribution; by simulation.
+ }
\item{var}{\code{signature(x = "EllipticalDistribution")}:
expectation of an elliptically symmetric distribution; exact.
}
Modified: branches/distr-2.6/pkg/distrEllipse/man/MultivarDistrList-class.Rd
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/man/MultivarDistrList-class.Rd 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/man/MultivarDistrList-class.Rd 2014-09-05 14:03:56 UTC (rev 967)
@@ -52,7 +52,6 @@
(DL2 <- MultivarDistrList(MVNorm(),
EllipticalDistribution(radDistr=Exp(), loc=c(1,2),
scale=diag(c(3,1))),MVt()))
-
}
\keyword{distribution}
\keyword{list}
Modified: branches/distr-2.6/pkg/distrEllipse/man/MultivarMixingDistribution-class.Rd
===================================================================
--- branches/distr-2.6/pkg/distrEllipse/man/MultivarMixingDistribution-class.Rd 2014-08-19 01:48:22 UTC (rev 966)
+++ branches/distr-2.6/pkg/distrEllipse/man/MultivarMixingDistribution-class.Rd 2014-09-05 14:03:56 UTC (rev 967)
@@ -20,7 +20,9 @@
\alias{Symmetry,MultivarMixingDistribution-method}
\alias{dimension,MultivarMixingDistribution-method}
\alias{dim,MultivarMixingDistribution-method}
-\alias{E,MultivarMixingDistribution,ANY,ANY-method}
+\alias{E,MultivarMixingDistribution,missing,missing-method}
+\alias{E,MultivarMixingDistribution,function,missing-method}
+\alias{var,MultivarMixingDistribution-method}
\alias{show,MultivarMixingDistribution-method}
\alias{showobj,MultivarMixingDistribution-method}
@@ -120,6 +122,8 @@
mylist2
p(mylist)(0.3)
mixDistr(mylist2)
+E(mylist)
+var(mylist)
##multivariate
E1 <- diag(1,2)\%*\%EllipticalDistribution(radDistr=Gammad())+c(1,2)
@@ -130,6 +134,8 @@
mylistD2
p(mylistD)
mixDistr(mylistD2)
+E(mylistD2)
+var(mylistD2)
}
\keyword{distribution}
\concept{discrete distribution}
More information about the Distr-commits
mailing list