From noreply at r-forge.r-project.org Fri Sep 5 16:03:56 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Sep 2014 16:03:56 +0200 (CEST) Subject: [Distr-commits] r967 - in branches/distr-2.6/pkg/distrEllipse: R inst man Message-ID: <20140905140356.B834918753B@r-forge.r-project.org> 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}