[Robast-commits] r1183 - in pkg: RandVar RandVar/R RandVar/inst RandVar/man RandVar/tests/Examples RobAStBase RobAStBase/R RobAStBase/inst RobAStBase/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 2 17:04:15 CET 2019
Author: ruckdeschel
Date: 2019-03-02 17:04:15 +0100 (Sat, 02 Mar 2019)
New Revision: 1183
Added:
pkg/RobAStBase/R/CheckMakeIC.R
pkg/RobAStBase/R/getPIC.R
pkg/RobAStBase/inst/chkTimeCode/
Modified:
pkg/RandVar/DESCRIPTION
pkg/RandVar/R/EuclRandVariable.R
pkg/RandVar/R/Expectation.R
pkg/RandVar/inst/NEWS
pkg/RandVar/man/0RandVar-package.Rd
pkg/RandVar/tests/Examples/RandVar-Ex.Rout.save
pkg/RobAStBase/DESCRIPTION
pkg/RobAStBase/NAMESPACE
pkg/RobAStBase/R/AllClass.R
pkg/RobAStBase/R/AllGeneric.R
pkg/RobAStBase/R/AllPlot.R
pkg/RobAStBase/R/AllShow.R
pkg/RobAStBase/R/ContIC.R
pkg/RobAStBase/R/HampIC.R
pkg/RobAStBase/R/IC.R
pkg/RobAStBase/R/TotalVarIC.R
pkg/RobAStBase/R/bALEstimate.R
pkg/RobAStBase/R/comparePlot.R
pkg/RobAStBase/R/ddPlot_utils.R
pkg/RobAStBase/R/generateICfct.R
pkg/RobAStBase/R/getBiasIC.R
pkg/RobAStBase/R/getRiskIC.R
pkg/RobAStBase/R/getboundedIC.R
pkg/RobAStBase/R/infoPlot.R
pkg/RobAStBase/R/internalGridHelpers.R
pkg/RobAStBase/R/kStepEstimate.R
pkg/RobAStBase/R/kStepEstimator.R
pkg/RobAStBase/R/move2bckRefParam.R
pkg/RobAStBase/R/oneStepEstimator.R
pkg/RobAStBase/R/optIC.R
pkg/RobAStBase/R/outlyingPlot.R
pkg/RobAStBase/R/plotWrapper.R
pkg/RobAStBase/R/qqplot.R
pkg/RobAStBase/R/returnlevelplot.R
pkg/RobAStBase/inst/NEWS
pkg/RobAStBase/man/0RobAStBase-package.Rd
pkg/RobAStBase/man/ALEstimate-class.Rd
pkg/RobAStBase/man/ContIC-class.Rd
pkg/RobAStBase/man/ContIC.Rd
pkg/RobAStBase/man/HampIC-class.Rd
pkg/RobAStBase/man/IC-class.Rd
pkg/RobAStBase/man/IC.Rd
pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd
pkg/RobAStBase/man/TotalVarIC-class.Rd
pkg/RobAStBase/man/TotalVarIC.Rd
pkg/RobAStBase/man/checkIC.Rd
pkg/RobAStBase/man/getBiasIC.Rd
pkg/RobAStBase/man/getBoundedIC.Rd
pkg/RobAStBase/man/getRiskIC.Rd
pkg/RobAStBase/man/internal_GridHelpers.Rd
pkg/RobAStBase/man/internals.Rd
pkg/RobAStBase/man/kStepEstimate-class.Rd
pkg/RobAStBase/man/kStepEstimator.Rd
pkg/RobAStBase/man/makeIC-methods.Rd
pkg/RobAStBase/man/oneStepEstimator.Rd
pkg/RobAStBase/man/optIC.Rd
pkg/RobAStBase/man/outlyingPlotIC.Rd
pkg/RobAStBase/man/plot-methods.Rd
Log:
preparation for release of 1.2: merged back RandVar and RobAStBase from branch 1.2 to trunk
Modified: pkg/RandVar/DESCRIPTION
===================================================================
--- pkg/RandVar/DESCRIPTION 2019-03-02 15:58:00 UTC (rev 1182)
+++ pkg/RandVar/DESCRIPTION 2019-03-02 16:04:15 UTC (rev 1183)
@@ -1,9 +1,9 @@
Package: RandVar
-Version: 1.1.0
-Date: 2018-08-01
+Version: 1.2.0
+Date: 2019-03-01
Title: Implementation of Random Variables
Description: Implements random variables by means of S4 classes and methods.
-Depends: R (>= 2.14.0), methods, distr(>= 2.5.2), distrEx(>= 2.5)
+Depends: R (>= 2.14.0), methods, distr(>= 2.8.0), distrEx(>= 2.8.0)
Imports: startupmsg
Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"),
email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel", role=c("aut",
@@ -15,4 +15,4 @@
URL: http://robast.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1081
+VCS/SVNRevision: 1178
Modified: pkg/RandVar/R/EuclRandVariable.R
===================================================================
--- pkg/RandVar/R/EuclRandVariable.R 2019-03-02 15:58:00 UTC (rev 1182)
+++ pkg/RandVar/R/EuclRandVariable.R 2019-03-02 16:04:15 UTC (rev 1183)
@@ -197,7 +197,7 @@
nrvalues <- length(RandVar)
res <- matrix(NA, nrow = nrvalues, ncol = RandVar at Range@dimension)
- if(liesInSupport(distr, x))
+ if(liesInSupport(distr, x, checkFin = TRUE))
for(i in 1:nrvalues) res[i,] <- RandVar at Map[[i]](x)
return(res)
@@ -219,7 +219,7 @@
for(i in 1:nrvalues){
fun <- RandVar at Map[[i]]
for(j in 1:nrow(x))
- if(!liesInSupport(distr, x[j,]))
+ if(!liesInSupport(distr, x[j,], checkFin = TRUE))
next
else
res[i,j,] <- fun(x[j,])
@@ -282,7 +282,7 @@
d <- RandVar at Dim
res <- array(NA, c(d[1], d[2], RandVar at Range@dimension))
- if(liesInSupport(distr, x)){
+ if(liesInSupport(distr, x, checkFin = TRUE)){
for(i in 1:d[1])
for(j in 1:d[2])
res[i,j,] <- RandVar at Map[[(i-1)*d[2] + j]](x)
@@ -308,7 +308,7 @@
for(j in 1:d[2]){
fun <- RandVar at Map[[(i-1)*d[2] + j]]
for(k in 1:nrow(x))
- if(!liesInSupport(distr, x[k,]))
+ if(!liesInSupport(distr, x[k,], checkFin = TRUE))
next
else
res[i,j,k,] <- fun(x[k,])
Modified: pkg/RandVar/R/Expectation.R
===================================================================
--- pkg/RandVar/R/Expectation.R 2019-03-02 15:58:00 UTC (rev 1182)
+++ pkg/RandVar/R/Expectation.R 2019-03-02 16:04:15 UTC (rev 1183)
@@ -1,138 +1,308 @@
-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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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), eval.parent(dotsFun,1)))
+ funwDc <- function(x,cond){ y <- c(x,cond); do.call(fun at Map[[i]], c(list(x=y), eval.parent(dotsFun,1)))}
+
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ return(res)
+ }
})
setMethod("E", signature(object = "DiscreteMVDistribution",
fun = "EuclRandMatrix",
@@ -144,166 +314,153 @@
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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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
+ class(attr(res,"diagnostic")) <- "DiagnosticClass"
+ }
+ 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)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 1183
More information about the Robast-commits
mailing list