[Robast-commits] r1142 - in branches/robast-1.2/pkg/RandVar: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 15 19:50:33 CEST 2018
Author: ruckdeschel
Date: 2018-08-15 19:50:33 +0200 (Wed, 15 Aug 2018)
New Revision: 1142
Modified:
branches/robast-1.2/pkg/RandVar/R/Expectation.R
branches/robast-1.2/pkg/RandVar/inst/NEWS
Log:
[RandVar] branch 1.2
+ E methods for RandVariables gain argument diagnostic
(like E()-methods in distrEx v 2.8.0)
+ E methods for RandVariables use filtering of dots arguments
(like E()-methods in distrEx v 2.8.0)
Modified: branches/robast-1.2/pkg/RandVar/R/Expectation.R
===================================================================
--- branches/robast-1.2/pkg/RandVar/R/Expectation.R 2018-08-12 22:00:00 UTC (rev 1141)
+++ branches/robast-1.2/pkg/RandVar/R/Expectation.R 2018-08-15 17:50:33 UTC (rev 1142)
@@ -1,138 +1,282 @@
-setMethod("E", signature(object = "UnivariateDistribution",
- fun = "EuclRandVariable",
- cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable is no Euclidean space")
- if(dimension(fun at Domain) != 1)
- stop("dimension of 'Domain' of the random variable has to be 1")
- if(dimension(fun at Range) != 1)
- stop("dimension of 'Range' of the random variable has to be 1")
+.locEfunLoop <- function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dimn <- length(fun)
+ nrdim <- fun at Range@dimension
+ res <- numeric(dimn)
+ if(nrdim > 1)
+ res <- matrix(0, nrow = dimn, ncol = nrdim)
+ diagn <- NULL
+ if(diagnostic) diagn <- vector("list", dimn)
+ for(i in 1:dimn){
+ buf <- E(object, fun = Map(fun)[[i]], useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn[[i]] <- attr(buf, "diagnostic")
+ if(nrdim>1) res[i,] <- buf else res[i] <- buf
+ }
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
+ return(res)
+ }
+.locEfunLoopCond <- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
dimn <- length(fun)
res <- numeric(dimn)
- for(i in 1:dimn) res[i] <- E(object, fun = Map(fun)[[i]], useApply = useApply, ...)
+ diagn <- if(diagnostic) vector("list", dimn) else NULL
+ dots <- list(...)
+ dotsI <- .filterEargs(dots)
+ Eargs0 <- list(object=object)
+ Eargs1 <- list(cond=cond, withCond=withCond, useApply = useApply, diagnostic = diagnostic)
+ for(i in 1:dimn){
+ dotsFun <- .filterFunargs(dots, fun at Map[[i]])
+
+ funwD <- function(x) do.call(fun at Map[[i]], c(list(x), dotsFun))
+ funwDc <- function(x,cond){ y <- c(x,cond); do.call(fun at Map[[i]], c(list(x=y), dotsFun))}
+
+ Eargs <- c(Eargs0, list(fun=if(withCond)funwDc else funwD), Eargs1, dotsI)
+ res[i] <- buf <- do.call(E, Eargs)
+ if(diagnostic) diagn[[i]] <- attr(buf, "diagnostic")
+ }
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
return(res)
- })
-setMethod("E", signature(object = "AbscontDistribution",
- fun = "EuclRandVariable",
- cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
+ }
+
+.locEfun <- function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
if(!is(fun at Domain, "EuclideanSpace"))
stop("'Domain' of the random variable is no Euclidean space")
if(dimension(fun at Domain) != 1)
stop("dimension of 'Domain' of the random variable has to be 1")
if(dimension(fun at Range) != 1)
stop("dimension of 'Range' of the random variable has to be 1")
+ .locEfunLoop(object = object, fun = fun, useApply = useApply, ..., diagnostic = diagnostic)
+ }
- dimn <- length(fun)
- res <- numeric(dimn)
- for(i in 1:dimn) res[i] <- E(object, fun = Map(fun)[[i]], useApply = useApply, ...)
+.locEmatfun <- function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ diagn <- NULL
+ res <- E(object, as(fun, "EuclRandVariable"), useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn <- attr(res, "diagnostic")
+ res <- matrix(res, nrow = nrow(fun))
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
+ return(res)
+ }
+.locElistfun <- function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ nrvalues <- length(fun)
+ res <- vector("list", nrvalues)
+ diagn <- NULL
+ if(diagnostic) diagn <- vector("list", nrvalues)
+ for(i in 1:nrvalues){
+# print(list(object, fun = fun[[i]], useApply = useApply, ..., diagnostic = diagnostic))
+ res[[i]] <- buf <- E(object, fun = fun[[i]], useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn[[i]] <- attr(buf, "diagnostic")
+ }
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
+ return(res)
+ }
+.locEMVfun <- function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+# print(list(object, fun, useApply, ..., diagnostic))
+ if(!is(fun at Domain, "EuclideanSpace"))
+ stop("'Domain' of the random variable is no Euclidean space")
+ if(fun at Domain@dimension != object at img@dimension)
+ stop("dimension of 'Domain' of the random variable is not equal\n",
+ "to dimension of 'img' of the distribution")
+ res <- .locEfunLoop(object = object, fun = fun, useApply = useApply, ..., diagnostic = diagnostic)
+ dim(res) <- c(length(fun),fun at Range@dimension)
return(res)
- })
-setMethod("E", signature(object = "DiscreteDistribution",
- fun = "EuclRandVariable",
- cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
+ }
+
+
+.locEfunCond <-
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable is no Euclidean space")
- if(dimension(fun at Domain) != 1)
- stop("dimension of 'Domain' of the random variable has to be 1")
+ stop("'Domain' of the random variable has to be a Euclidean Space")
+ if(withCond){
+ if(fun at Domain@dimension != (1+length(cond)))
+ stop("wrong dimension of 'Domain' of 'fun'")
+ }else{
+ if(fun at Domain@dimension != 1)
+ stop("dimension of 'Domain' of 'fun' has to be 1")
+ }
if(dimension(fun at Range) != 1)
stop("dimension of 'Range' of the random variable has to be 1")
- dimn <- length(fun)
- res <- numeric(dimn)
- for(i in 1:dimn) res[i] <- E(object, fun = Map(fun)[[i]], useApply = useApply, ...)
+ return(.locEfunLoopCond(object = object, fun = fun, cond = cond, withCond = withCond,
+ useApply = useApply, ..., diagnostic = diagnostic))
+ }
+.locEmatfunCond <- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ diagn <- NULL
+ res <- E(object, as(fun, "EuclRandVariable"), cond = cond,
+ withCond = withCond, useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn <- attr(res, "diagnostic")
+ res <- matrix(res, nrow = nrow(fun))
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
return(res)
- })
+ }
+
+.locElistfunCond <- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ nrvalues <- length(fun)
+ diagn <- if(diagnostic) vector("list", nrvalues) else NULL
+ res <- vector("list", nrvalues)
+ for(i in 1:nrvalues){
+ res[[i]] <- buf <- E(object, fun=fun[[i]], cond = cond, withCond = withCond, useApply = useApply, ..., diagnostic = diagnostic)
+ if(diagnostic) diagn[[i]] <- attr(buf, "diagnostic")
+ }
+ if(!is.null(diagn)) attr(res,"diagnostic") <- diagn
+ return(res)
+ }
+
+
+
setMethod("E", signature(object = "UnivariateDistribution",
+ fun = "EuclRandVariable",
+ cond = "missing"),
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ mc <- match.call()
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- mc
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+setMethod("E", signature(object = "AbscontDistribution",
+ fun = "EuclRandVariable",
+ cond = "missing"),
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+setMethod("E", signature(object = "DiscreteDistribution",
+ fun = "EuclRandVariable",
+ cond = "missing"),
+ function(object, fun, useApply = TRUE, ...){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locEfun,c(list(object = object, fun = fun, useApply = useApply, diagnostic= FALSE), dotsI))
+ })
+
+setMethod("E", signature(object = "UnivariateDistribution",
fun = "EuclRandMatrix",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), useApply = useApply, ...), nrow = nrow(fun))
- })
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEmatfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+
setMethod("E", signature(object = "AbscontDistribution",
fun = "EuclRandMatrix",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), useApply = useApply, ...), nrow = nrow(fun))
- })
-setMethod("E", signature(object = "DiscreteDistribution",
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEmatfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+
+setMethod("E", signature(object = "DiscreteDistribution",
fun = "EuclRandMatrix",
cond = "missing"),
function(object, fun, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), useApply = useApply, ...), nrow = nrow(fun))
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locEmatfun,c(list(object = object, fun = fun, useApply = useApply, diagnostic= FALSE), dotsI))
})
+
setMethod("E", signature(object = "UnivariateDistribution",
fun = "EuclRandVarList",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues) res[[i]] <- E(object, fun[[i]], useApply = useApply, ...)
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locElistfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
setMethod("E", signature(object = "AbscontDistribution",
fun = "EuclRandVarList",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues) res[[i]] <- E(object, fun[[i]], useApply = useApply, ...)
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locElistfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
-setMethod("E", signature(object = "DiscreteDistribution",
+setMethod("E", signature(object = "DiscreteDistribution",
fun = "EuclRandVarList",
cond = "missing"),
function(object, fun, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues) res[[i]] <- E(object, fun[[i]], useApply = useApply, ...)
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locElistfun,c(list(object = object, fun = fun, useApply = useApply, diagnostic= FALSE), dotsI))
+ })
- return(res)
- })
setMethod("E", signature(object = "MultivariateDistribution",
fun = "EuclRandVariable",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable is no Euclidean space")
- if(fun at Domain@dimension != object at img@dimension)
- stop("dimension of 'Domain' of the random variable is not equal\n",
- "to dimension of 'img' of the distribution")
- dimn <- length(fun)
- res <- matrix(0, nrow = dimn, ncol = fun at Range@dimension)
- for(i in 1:dimn) res[i,] <- E(object, fun at Map[[i]], useApply = useApply, ...)
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEMVfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
+
setMethod("E", signature(object = "DiscreteMVDistribution",
fun = "EuclRandVariable",
cond = "missing"),
function(object, fun, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable is no Euclidean space")
- if(fun at Domain@dimension != object at img@dimension)
- stop("dimension of 'Domain' of the random variable is not equal\n",
- "to dimension of 'img' of the distribution")
- dimn <- length(fun)
- res <- matrix(0, nrow = dimn, ncol = fun at Range@dimension)
- for(i in 1:dimn) res[i,] <- E(object, fun at Map[[i]], useApply = useApply, ...)
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locEMVfun,c(list(object = object, fun = fun, useApply = useApply, diagnostic= FALSE), dotsI))
+ })
- return(res)
- })
-setMethod("E", signature(object = "MultivariateDistribution",
+setMethod("E", signature(object = "MultivariateDistribution",
fun = "EuclRandMatrix",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- array(E(object, as(fun, "EuclRandVariable"), useApply = useApply, ...),
- c(nrow(fun), ncol(fun), fun at Range@dimension))
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ if(!diagnostic){
+ return(array(E(object, as(fun, "EuclRandVariable"), useApply = useApply, ..., diagnostic = diagnostic),
+ c(nrow(fun), ncol(fun), fun at Range@dimension)))
+ }else{
+ res <- E(object, as(fun, "EuclRandVariable"), useApply = useApply, ..., diagnostic = diagnostic)
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ res <- array(res, c(nrow(fun), ncol(fun), fun at Range@dimension))
+ attr(res, "diagnostic") <- diagn
+ return(res)
+ }
})
setMethod("E", signature(object = "DiscreteMVDistribution",
fun = "EuclRandMatrix",
@@ -144,166 +288,146 @@
setMethod("E", signature(object = "MultivariateDistribution",
fun = "EuclRandVarList",
cond = "missing"),
- function(object, fun, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues)
- res[[i]] <- E(object, fun[[i]], useApply = useApply, ...)
+ function(object, fun, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locElistfun, c(list(object=object, fun= fun, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
-setMethod("E", signature(object = "DiscreteMVDistribution",
+setMethod("E", signature(object = "DiscreteMVDistribution",
fun = "EuclRandVarList",
cond = "missing"),
function(object, fun, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues)
- res[[i]] <- E(object, fun[[i]], useApply = useApply, ...)
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locElistfun,c(list(object = object, fun = fun, useApply = useApply, diagnostic= FALSE), dotsI))
+ })
- return(res)
- })
setMethod("E", signature(object = "UnivariateCondDistribution",
fun = "EuclRandVariable",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable has to be a Euclidean Space")
- if(withCond){
- if(fun at Domain@dimension != (1+length(cond)))
- stop("wrong dimension of 'Domain' of 'fun'")
- }else{
- if(fun at Domain@dimension != 1)
- stop("dimension of 'Domain' of 'fun' has to be 1")
- }
- if(dimension(fun at Range) != 1)
- stop("dimension of 'Range' of the random variable has to be 1")
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- dimn <- length(fun)
- res <- numeric(dimn)
- if(withCond){
- for(i in 1:dimn){
- fun1 <- function(x, cond, fct){ fct(c(x, cond)) }
- res[i] <- E(object, fun1, cond, fct = fun at Map[[i]],
- withCond, useApply = useApply, ...)
- }
- }else{
- for(i in 1:dimn) res[i] <- E(object, fun at Map[[i]], cond, useApply = useApply, ...)
- }
-
- return(res)
- })
-setMethod("E", signature(object = "AbscontCondDistribution",
+setMethod("E", signature(object = "AbscontCondDistribution",
fun = "EuclRandVariable",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable has to be a Euclidean Space")
- if(withCond){
- if(fun at Domain@dimension != (1+length(cond)))
- stop("wrong dimension of 'Domain' of 'fun'")
- }else{
- if(fun at Domain@dimension != 1)
- stop("dimension of 'Domain' of 'fun' has to be 1")
- }
- if(dimension(fun at Range) != 1)
- stop("dimension of 'Range' of the random variable has to be 1")
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- dimn <- length(fun)
- res <- numeric(dimn)
- if(withCond){
- for(i in 1:dimn){
- fun1 <- function(x, cond, fct){ fct(c(x, cond)) }
- res[i] <- E(object, fun1, cond, fct = fun at Map[[i]],
- withCond, useApply = useApply, ...)
- }
- }else{
- for(i in 1:dimn) res[i] <- E(object, fun at Map[[i]], cond, useApply = useApply, ...)
- }
-
- return(res)
- })
-setMethod("E", signature(object = "DiscreteCondDistribution",
+setMethod("E", signature(object = "DiscreteCondDistribution",
fun = "EuclRandVariable",
cond = "numeric"),
function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- if(!is(fun at Domain, "EuclideanSpace"))
- stop("'Domain' of the random variable has to be a Euclidean Space")
- if(withCond){
- if(fun at Domain@dimension != (1+length(cond)))
- stop("wrong dimension of 'Domain' of 'fun'")
- }else{
- if(fun at Domain@dimension != 1)
- stop("dimension of 'Domain' of 'fun' has to be 1")
- }
- if(dimension(fun at Range) != 1)
- stop("dimension of 'Range' of the random variable has to be 1")
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locEfunCond,c(list(object = object, fun = fun, cond=cond, withCond = withCond,
+ useApply = useApply, diagnostic= FALSE), dotsI))
+ })
- dimn <- length(fun)
- res <- numeric(dimn)
- if(withCond){
- for(i in 1:dimn){
- fun1 <- function(x, cond, fct){ fct(c(x, cond)) }
- res[i] <- E(object, fun1, cond, fct = fun at Map[[i]],
- withCond, useApply = useApply, ...)
- }
- }else{
- for(i in 1:dimn) res[i] <- E(object, fun at Map[[i]], cond, useApply = useApply, ...)
- }
-
- return(res)
- })
setMethod("E", signature(object = "UnivariateCondDistribution",
fun = "EuclRandMatrix",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), cond, withCond,
- useApply = useApply, ...), nrow = nrow(fun))
- })
-setMethod("E", signature(object = "AbscontCondDistribution",
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEmatfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+
+setMethod("E", signature(object = "AbscontCondDistribution",
fun = "EuclRandMatrix",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), cond, withCond,
- useApply = useApply, ...), nrow = nrow(fun))
- })
-setMethod("E", signature(object = "DiscreteCondDistribution",
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locEmatfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
+
+setMethod("E", signature(object = "DiscreteCondDistribution",
fun = "EuclRandMatrix",
cond = "numeric"),
function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- matrix(E(object, as(fun, "EuclRandVariable"), cond, withCond,
- useApply = useApply, ...), nrow = nrow(fun))
- })
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locEmatfunCond,c(list(object = object, fun = fun, cond=cond, withCond = withCond,
+ useApply = useApply, diagnostic= FALSE), dotsI))
+ })
+
setMethod("E", signature(object = "UnivariateCondDistribution",
fun = "EuclRandVarList",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues)
- res[[i]] <- E(object, fun[[i]], cond, withCond, useApply = useApply, ...)
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locElistfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
setMethod("E", signature(object = "AbscontCondDistribution",
fun = "EuclRandVarList",
cond = "numeric"),
- function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues)
- res[[i]] <- E(object, fun[[i]], cond, withCond, useApply = useApply, ...)
+ function(object, fun, cond, withCond = FALSE, useApply = TRUE, ..., diagnostic = FALSE){
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ res <- do.call(.locElistfunCond, c(list(object=object, fun= fun, cond=cond,
+ withCond = withCond, useApply = useApply,
+ diagnostic = diagnostic), dotsI))
+ if(diagnostic){
+ diagn <- attr(res,"diagnostic")
+ diagn[["call"]] <- match.call()
+ attr(res,"diagnostic") <- diagn
+ }
+ return(res)
+ })
- return(res)
- })
-setMethod("E", signature(object = "DiscreteCondDistribution",
+setMethod("E", signature(object = "DiscreteCondDistribution",
fun = "EuclRandVarList",
cond = "numeric"),
function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
- nrvalues <- length(fun)
- res <- vector("list", nrvalues)
- for(i in 1:nrvalues)
- res[[i]] <- E(object, fun[[i]], cond, withCond, useApply = useApply, ...)
+ dots <- list(...); dotsI <- .filterEargs(dots); dotsI$diagnostic <- NULL
+ do.call(.locElistfunCond,c(list(object = object, fun = fun, cond=cond, withCond = withCond,
+ useApply = useApply, diagnostic= FALSE), dotsI))
+ })
- return(res)
- })
Modified: branches/robast-1.2/pkg/RandVar/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/RandVar/inst/NEWS 2018-08-12 22:00:00 UTC (rev 1141)
+++ branches/robast-1.2/pkg/RandVar/inst/NEWS 2018-08-15 17:50:33 UTC (rev 1142)
@@ -13,11 +13,15 @@
user-visible CHANGES:
+ require more recent distr/distrEx versions
++ E methods for RandVariables gain argument diagnostic
+ (like E()-methods in distrEx v 2.8.0)
under the hood:
+ for consistency to the univariate methods, the liesInSupport() method for
DiscreteMVDistribution is called with an extra argument checkFin,
which is not yet used.
++ E methods for RandVariables use filtering of dots arguments
+ (like E()-methods in distrEx v 2.8.0)
#######################################
version 1.1
More information about the Robast-commits
mailing list