[Distr-commits] r885 - in branches/distr-2.5/pkg/distrMod: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Feb 15 12:42:37 CET 2013


Author: ruckdeschel
Date: 2013-02-15 12:42:37 +0100 (Fri, 15 Feb 2013)
New Revision: 885

Modified:
   branches/distr-2.5/pkg/distrMod/NAMESPACE
   branches/distr-2.5/pkg/distrMod/R/AllClass.R
   branches/distr-2.5/pkg/distrMod/R/Estimate.R
   branches/distr-2.5/pkg/distrMod/R/Estimator.R
   branches/distr-2.5/pkg/distrMod/R/MCEstimator.R
   branches/distr-2.5/pkg/distrMod/R/MDEstimator.R
   branches/distr-2.5/pkg/distrMod/R/MLEstimator.R
   branches/distr-2.5/pkg/distrMod/R/confint.R
   branches/distr-2.5/pkg/distrMod/R/internalMleCalc.R
   branches/distr-2.5/pkg/distrMod/R/modifyModel.R
   branches/distr-2.5/pkg/distrMod/man/Estimator.Rd
   branches/distr-2.5/pkg/distrMod/man/L2ParamFamily-class.Rd
   branches/distr-2.5/pkg/distrMod/man/MCEstimator.Rd
   branches/distr-2.5/pkg/distrMod/man/MDEstimator.Rd
   branches/distr-2.5/pkg/distrMod/man/MLEstimator.Rd
   branches/distr-2.5/pkg/distrMod/man/internalClassUnions-class.Rd
   branches/distr-2.5/pkg/distrMod/man/internalmleHelpers.Rd
   branches/distr-2.5/pkg/distrMod/man/modifyModel-methods.Rd
Log:
distrMod: delayed calculation of variances and allow to skip or delay calculation of L2derivDistr; to this end introduced new class unions "OptionalNumericOrMatrixOrCall", "OptionalDistrListOrCall"; respectively at certain stages, evaluation of the call must the be forced

Modified: branches/distr-2.5/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.5/pkg/distrMod/NAMESPACE	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/NAMESPACE	2013-02-15 11:42:37 UTC (rev 885)
@@ -6,8 +6,9 @@
 import("RandVar")
 
 importFrom("stats4","profile")
-exportClasses("MatrixorFunction",
-              "OptionalNumericOrMatrix", "ShowDetails",
+exportClasses("MatrixorFunction", "OptionalNumericOrMatrixOrCall",
+              "OptionalDistrListOrCall", "OptionalNumericOrMatrix", 
+			  "ShowDetails",
               "FunctionSymmetry", "NonSymmetric", "EvenSymmetric", "OddSymmetric",
               "FunSymmList",
               "ParamFamParameter",

Modified: branches/distr-2.5/pkg/distrMod/R/AllClass.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/AllClass.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/AllClass.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -51,8 +51,9 @@
 setClassUnion("MatrixorFunction", c("matrix", "OptionalFunction"))
 ## matrix, numeric or NULL -- a class for covariance slots
 setClassUnion("OptionalNumericOrMatrix", c("OptionalNumeric", "matrix"))
+setClassUnion("OptionalNumericOrMatrixOrCall", c("OptionalNumericOrMatrix", "call"))
 ## DistrList or NULL -- a class for slot L2DerivDistr below
-setClassUnion("OptionalDistrList", c("DistrList", "NULL"))
+setClassUnion("OptionalDistrListOrCall", c("DistrList", "NULL", "call"))
 
 ################################
 ##
@@ -165,7 +166,7 @@
             representation(L2deriv = "EuclRandVarList",
                            L2deriv.fct = "function", ## new: a function in theta which produces L2deriv
                            L2derivSymm = "FunSymmList",
-                           L2derivDistr = "OptionalDistrList",
+                           L2derivDistr = "OptionalDistrListOrCall",
                            L2derivDistrSymm = "DistrSymmList",
                            FisherInfo = "PosSemDefSymmMatrix",
                            FisherInfo.fct = "function" ## new: a function in theta which produces FisherInfo
@@ -409,14 +410,14 @@
                         estimate = "ANY",
                         samplesize = "numeric",
                         completecases = "logical",
-                        asvar = "OptionalNumericOrMatrix",
+                        asvar = "OptionalNumericOrMatrixOrCall",
                         Infos = "matrix",
                         estimate.call = "call",
                         nuis.idx = "OptionalNumeric",
                         fixed = "OptionalNumeric",
                         trafo = "list",
                         untransformed.estimate = "ANY",
-                        untransformed.asvar = "OptionalNumericOrMatrix"),
+                        untransformed.asvar = "OptionalNumericOrMatrixOrCall"),
          prototype(name = "Estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),

Modified: branches/distr-2.5/pkg/distrMod/R/Estimate.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/Estimate.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/Estimate.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -60,9 +60,15 @@
 setMethod("samplesize", "Estimate", function(object, onlycompletecases = TRUE)
   	    object at samplesize+(1-onlycompletecases)*sum(object at completecases==FALSE))
 setMethod("completecases", "Estimate", function(object) object at completecases)
-setMethod("asvar", "Estimate", function(object)
-                if(!is.null(object at asvar))
-                    as.matrix(object at asvar))
+setMethod("asvar", "Estimate", function(object){
+                if(is.null(object at asvar)) return(NULL)
+                asvar0 <- object at asvar
+                if(is.call(asvar0)) asvar0 <- eval(asvar0)
+                if(is.null(asvar0)) return(NULL)
+                asvar0 <- as.matrix(asvar0)
+                eval.parent(substitute(object at asvar <- asvar0))
+                return(asvar0)
+})
 
 setReplaceMethod("asvar", "Estimate", 
                   function(object, value){ 
@@ -76,10 +82,14 @@
           }
           object})
 
-setMethod("untransformed.asvar", "Estimate", function(object) 
-           if(!is.null(object at untransformed.asvar))
-               as.matrix(object at untransformed.asvar)
-           else NULL    )
+setMethod("untransformed.asvar", "Estimate", function(object){
+                asvar0 <- object at untransformed.asvar
+                if(is.null(asvar0)) return(NULL)
+                if(is.call(asvar0)) asvar0 <- eval(asvar0)
+                asvar0 <- as.matrix(asvar0)
+                eval.parent(substitute(object at untransformed.asvar<-asvar0))
+                return(asvar0)
+                })
 
 
 setMethod("nuisance", "Estimate", function(object) { 

Modified: branches/distr-2.5/pkg/distrMod/R/Estimator.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/Estimator.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/Estimator.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -3,7 +3,7 @@
 ###############################################################################
 Estimator <- function(x, estimator, name, Infos, asvar = NULL, nuis.idx,
                       trafo = NULL, fixed = NULL, asvar.fct, na.rm = TRUE, ...,
-                      ParamFamily = NULL){
+                      ParamFamily = NULL, .withEvalAsVar = TRUE){
 
     name.est <- paste(deparse(substitute(estimator)),sep="",collapse="")     
     es.call <- match.call()
@@ -72,12 +72,20 @@
     
     asvar <- NULL
 
-    if(!missing(asvar.fct)){
+    if(!missing(asvar.fct) &&!is.null(asvar.fct)){
        PFam <- NULL
-       if(!is.null(ParamFamily)) PFam <- modifyModel(ParamFamily, param)
-       asvar.try <- try(asvar.fct(L2Fam = PFam, param = param, ...),
-                         silent=TRUE)
-       if(!is(asvar.try,"try-error")) asvar <- asvar.try
+       if(!is.null(ParamFamily))
+           PFam <- modifyModel(ParamFamily, param, .withL2derivDistr = FALSE)
+       asvar.tfct <- function(PFam, param){
+           asvar.try <- try(asvar.fct(L2Fam = PFam, param = param, ...),
+                            silent = TRUE)
+           as0 <- if(is(asvar.try,"try-error")) NULL else asvar.try
+           return(as0)
+       }
+       asvar <- if(.withEvalAsVar) asvar.tfct(PFam, param) else{
+                  substitute(do.call(asfct, args=list(PF,pa)),
+                                list(asfct = asvar.tfct, PF = PFam, pa = param))
+                  }
     }
     res at asvar <- asvar
     res at untransformed.asvar <- asvar
@@ -118,9 +126,19 @@
        estimate <- fctv$fval
        trafm <- fctv$mat
        if(!is.null(asvar)){
-           asvar <- trafm%*%asvar[idm,idm]%*%t(trafm)
-           rownames(asvar) <- colnames(asvar) <- c(names(estimate))
-          }
+           asvar.trfct <- function(tfm, asvm, nms){
+              asvar.. <- tfm%*%asvm%*%t(tfm)
+              rownames(asvar..) <- colnames(asvar..) <- c(nms)
+              return(asvar..)
+           }
+           if(is.call(asvar)){
+              asvar <- substitute(do.call(asfct, args=list(trafm0,asvm0,nms0)),
+                          list(asfct = asvar.trfct, trafm0 = trafm,
+                               asvm0 = asvar[idm,idm], nms0 = names(estimate)))
+           }else{
+              asvar <- asvar.trfct(trafm,asvar[idm,idm],names(estimate))
+           }
+       }
     }
   estimator at estimate <- estimate
   estimator at asvar <- asvar

Modified: branches/distr-2.5/pkg/distrMod/R/MCEstimator.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/MCEstimator.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/MCEstimator.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -4,7 +4,7 @@
 MCEstimator <- function(x, ParamFamily, criterion, crit.name, 
                         startPar = NULL, 
                         Infos, trafo = NULL, penalty = 1e20, validity.check = TRUE,
-                        asvar.fct, na.rm = TRUE, ...){
+                        asvar.fct, na.rm = TRUE, ..., .withEvalAsVar = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -45,7 +45,8 @@
                               trafo = trafo, 
                               res.name = paste("Minimum", crit.name, 
                                                "estimate", sep=" ", collapse=""), 
-                              call = quote(es.call))) 
+                              call = quote(es.call),
+                              .withEvalAsVar=.withEvalAsVar))
 
     if(!is.null(asv))   argList <- c(argList, asvar.fct = asv)
     if(!is.null(dots))  argList <- c(argList, dots)

Modified: branches/distr-2.5/pkg/distrMod/R/MDEstimator.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/MDEstimator.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/MDEstimator.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -6,7 +6,7 @@
                         startPar = NULL,  Infos, 
                         trafo = NULL, penalty = 1e20,
                         validity.check = TRUE, asvar.fct, na.rm = TRUE,
-                        ...){
+                        ..., .withEvalAsVar = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -43,7 +43,8 @@
                               trafo = trafo, 
                               res.name = paste("Minimum", dist.name, 
                                                "estimate", sep = " "), 
-                              call = quote(es.call)))
+                              call = quote(es.call),
+                              .withEvalAsVar = .withEvalAsVar))
 
     if(!missing(asvar.fct))   argList <- c(argList, asvar.fct = asvar.fct)
     if(!is.null(dots))  argList <- c(argList, dots)

Modified: branches/distr-2.5/pkg/distrMod/R/MLEstimator.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/MLEstimator.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/MLEstimator.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -6,7 +6,8 @@
 ## Maximum-Likelihood estimator
 MLEstimator <- function(x, ParamFamily, startPar = NULL, 
                         Infos, trafo = NULL, penalty = 1e20,
-                        validity.check = TRUE, na.rm = TRUE, ...){
+                        validity.check = TRUE, na.rm = TRUE,
+                        ..., .withEvalAsVar = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -39,9 +40,9 @@
                                   solve(FisherInfo(PFam, param = param))
            }else NULL
     
-    argList <- list(res0, PFam = ParamFamily, trafo = trafo, 
+    argList <- list(res0, PFam = ParamFamily, trafo = trafo,
                       res.name = "Maximum likelihood estimate",
-                      call = quote(es.call)) 
+                      call = quote(es.call), .withEvalAsVar=.withEvalAsVar)
 
     if(!is.null(asv))   argList <- c(argList, asvar.fct = asv)
     if(!is.null(dots))  argList <- c(argList, dots)

Modified: branches/distr-2.5/pkg/distrMod/R/confint.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/confint.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/confint.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -14,15 +14,15 @@
           function(object, method, level = 0.95) {
    objN <- paste(deparse(substitute(object)),sep="",collapse="")
 
-   if(is.null(object at asvar))
-      { cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n",
-            objN))
-        return(NULL) }
+   asm <- asvar(object)
+   if(is.null(asm)){
+      cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n",
+          objN))
+      return(NULL)
+   }
+   sd0 <- sqrt(diag(asm)/object at samplesize)
+   names(sd0) <- names(object at estimate)
 
-
-    sd0 <- sqrt(diag(as.matrix(object at asvar))/object at samplesize)
-    names(sd0) <- names(object at estimate)
-
 ### code borrowed from confint.default from package stats
     a <- (1 - level)/2
     a <- c(a, 1 - a)

Modified: branches/distr-2.5/pkg/distrMod/R/internalMleCalc.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/internalMleCalc.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/internalMleCalc.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -20,7 +20,8 @@
 #internal helper
 ##########################################################################
 .process.meCalcRes <- function(res, PFam, trafo, res.name, call,
-                               asvar.fct, check.validity, ...){
+                               asvar.fct, check.validity, ...,
+                               .withEvalAsVar = TRUE){
     lmx <- length(main(PFam))
     lnx <- length(nuisance(PFam))
     idx <- 1:lmx
@@ -87,9 +88,18 @@
 
     asvar <- NULL
     if(!missing(asvar.fct))
-       if(!is.null(asvar.fct))
-           asvar <- asvar.fct(PFam, param, ...)
-
+       if(!is.null(asvar.fct)){
+           asvar.tfct <- function(PFam, param, ...){
+              asvar.try <- try(asvar.fct(L2Fam = PFam, param = param, ...),
+                                         silent = TRUE)
+              as0 <- if(is(asvar.try,"try-error")) NULL else asvar.try
+              return(as0)
+           }
+           asvar <- substitute(do.call(asfct, args=c(list(PFam0, param0, ...))),
+                               list(asfct=asvar.tfct, PFam0=PFam, param0=param))
+       }
+    if(.withEvalAsVar) asvar <- eval(asvar)
+    
     untransformed.estimate <- theta
     untransformed.asvar <- asvar
 
@@ -98,9 +108,20 @@
        estimate <- .deleteDim(estimate)
        trafm <- traf0$mat
        if(!is.null(asvar)){
-           asvar <- trafm%*%asvar[idx,idx]%*%t(trafm)
-           rownames(asvar) <- colnames(asvar) <- c(names(estimate))
-          }
+           asvar.trfct <- function(trafm, asvarm, nms){
+              asvar <- trafm%*%asvarm%*%t(trafm)
+              rownames(asvar) <- colnames(asvar) <- c(nms)
+              return(asvar)
+           }
+           asvar <- if(.withEvalAsVar){
+                 asvar.trfct(trafm, asvar[idx,idx], names(estimate))
+           }else{
+                 substitute(do.call(asfct, args=list(trafm0, asvarm0, nms0)),
+                              list(asfct = asvar.trfct, trafm0 = trafm,
+                                    asvarm0 = asvar[idx,idx],
+                                    nms0 = names(estimate)))
+           }
+       }
     }else{
        if(hasnodim.main)
            estimate <- .deleteDim(estimate)

Modified: branches/distr-2.5/pkg/distrMod/R/modifyModel.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/modifyModel.R	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/R/modifyModel.R	2013-02-15 11:42:37 UTC (rev 885)
@@ -68,10 +68,11 @@
           #did not work
           #lapply(M at L2derivSymm, function(x) assign("x",NonSymmetric()))
           #lapply(M at L2derivDistrSymm, function(x) assign("x",NoSymmetry()))
-          if(.withL2derivDistr)
-             M at L2derivDistr <- imageDistr(RandVar = M at L2deriv,
-                                          distr = M at distribution)      
-          
+          callIm <- substitute(imageDistr(RandVar = M1l, distr = M2l),
+                                          list(M1l=M at L2deriv, M2l=M at distribution)
+                                       )
+          M at L2derivDistr <- if(.withL2derivDistr) eval(callIm) else callIm
+
           M1 <- existsPIC(M)
 
           if(paste(M at fam.call[1]) == "L2ParamFamily")

Modified: branches/distr-2.5/pkg/distrMod/man/Estimator.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/Estimator.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/Estimator.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -9,7 +9,7 @@
 \usage{
 Estimator(x, estimator, name, Infos, asvar = NULL, nuis.idx,
           trafo = NULL, fixed = NULL, asvar.fct, na.rm = TRUE, ...,
-          ParamFamily = NULL)
+          ParamFamily = NULL, .withEvalAsVar = TRUE)
 }
 \arguments{
   \item{x}{ (empirical) data }
@@ -32,6 +32,10 @@
   \item{\dots}{ further arguments to \code{estimator}.}
   \item{ParamFamily}{an optional object of class \code{ParamFamily}. Passed on
      to \code{asvar.fct} to compute asymptotic variances.}
+  \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
+                   (if \code{asvar.fct} is given) or
+                   just the call be returned?}
+
 }
 \details{
   The argument \code{criterion} has to be a function with arguments the 

Modified: branches/distr-2.5/pkg/distrMod/man/L2ParamFamily-class.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/L2ParamFamily-class.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/L2ParamFamily-class.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -82,8 +82,9 @@
       object of class \code{"FunSymmList"}:
       symmetry of the maps included in \code{L2deriv}. }
     \item{\code{L2derivDistr}}{
-      object of class \code{"OptionalDistrList"} (i.e., \code{NULL} or
-      an object of class \code{"DistrList"}): if non-null, a
+      object of class \code{"OptionalDistrListOrCall"} (i.e., \code{NULL} or
+      an object of class \code{"DistrList"} or the respective call to generate
+      the latter object): if non-null and non-call, a
       list which includes the distribution of \code{L2deriv}. }
     \item{\code{L2derivDistrSymm}}{
       object of class \code{"DistrSymmList"}:

Modified: branches/distr-2.5/pkg/distrMod/man/MCEstimator.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/MCEstimator.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/MCEstimator.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -13,7 +13,8 @@
 \usage{
 MCEstimator(x, ParamFamily, criterion, crit.name, 
             startPar = NULL, Infos, trafo = NULL, 
-            penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE, ...)
+            penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE,
+            ..., .withEvalAsVar = TRUE)
 }
 \arguments{
   \item{x}{ (empirical) data }
@@ -41,6 +42,9 @@
   \item{na.rm}{logical: if  \code{TRUE}, the estimator is evaluated at \code{complete.cases(x)}.}
   \item{\dots}{ further arguments to \code{criterion} or \code{optimize}
     or \code{optim}, respectively. }
+  \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
+                   (if \code{asvar.fct} is given) or
+                   just the call be returned?}
 }
 \details{
   The argument \code{criterion} has to be a function with arguments the 

Modified: branches/distr-2.5/pkg/distrMod/man/MDEstimator.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/MDEstimator.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/MDEstimator.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -9,7 +9,8 @@
 \usage{
 MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name, 
             paramDepDist = FALSE, startPar = NULL,  Infos, trafo = NULL,
-            penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE, ...)
+            penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE,
+            ..., .withEvalAsVar = TRUE)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -43,6 +44,9 @@
   \item{na.rm}{logical: if  \code{TRUE}, the estimator is evaluated at \code{complete.cases(x)}.}
   \item{\dots}{ further arguments to \code{criterion} or \code{optimize}
     or \code{optim}, respectively. }
+  \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
+                   (if \code{asvar.fct} is given) or
+                   just the call be returned?}
 }
 \details{
   The argument \code{distance} has to be a (generic) function with arguments 

Modified: branches/distr-2.5/pkg/distrMod/man/MLEstimator.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/MLEstimator.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/MLEstimator.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -11,7 +11,8 @@
 \usage{
 MLEstimator(x, ParamFamily, startPar = NULL, 
             Infos, trafo = NULL, penalty = 1e20,
-            validity.check = TRUE, na.rm = TRUE, ...)
+            validity.check = TRUE, na.rm = TRUE, ...,
+            .withEvalAsVar = TRUE)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -32,6 +33,9 @@
   \item{na.rm}{logical: if  \code{TRUE}, the estimator is evaluated at \code{complete.cases(x)}.}
   \item{\dots}{ further arguments to \code{criterion} or \code{optimize}
     or \code{optim}, respectively. }
+  \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
+                   (if \code{asvar.fct} is given) or
+                   just the call be returned?}
 }
 \details{
   The function uses \code{\link{mleCalc}}

Modified: branches/distr-2.5/pkg/distrMod/man/internalClassUnions-class.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/internalClassUnions-class.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/internalClassUnions-class.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -2,6 +2,8 @@
 \docType{class}
 \alias{InternalClassUnions}
 \alias{OptionalNumericOrMatrix-class}
+\alias{OptionalNumericOrMatrixOrCall-class}
+\alias{OptionalDistrListOrCall-class}
 \alias{MatrixorFunction-class}
 \alias{ShowDetails-class}
 \alias{L2LocationScaleUnion-class}
@@ -32,11 +34,18 @@
 These classes are used internally to make available methods or to allow
 slots of classes to be filled with varying types. In particular
 \describe{
-\item{\code{"OptionalNumericOrMatrix"}}{may contain objects of class  
-      \code{"OptionalNumeric"} or \code{"matrix"}; it is used e.g. for 
+\item{\code{"OptionalNumericOrMatrix"}}{may contain objects of class
+      \code{"OptionalNumeric"} or \code{"matrix"};}
+\item{\code{"OptionalNumericOrMatrixOrCall"}}{may contain objects of class
+      \code{"OptionalNumericOrMatrix"} or \code{"call"}; it is used e.g. for
        slot \code{asvar} of class \code{"Estimate"}, as it may or may not be 
-       present but if so it has to be a number (numeric) or a matrix.}
-\item{\code{"MatrixorFunction"}}{may contain objects of class  
+       present or be a call; otherwise it has to be a number (numeric) or a matrix.}
+\item{\code{"OptionalDistrListOrCall"}}{may contain objects of class
+      \code{"DistrList"} or \code{"call"}; it is used e.g. for
+       slot \code{L2derivDistr} of class \code{"L2ParamFammily"},
+       as it may or may not be present or be a call;
+       otherwise it has to be a list of distributions.}
+\item{\code{"MatrixorFunction"}}{may contain objects of class
       \code{"OptionalFunction"} or \code{"matrix"}; it is used e.g. for 
        slot \code{trafo} of class \code{"ParamFamParameter"}, as it may or may not be 
        present and if it is present, it has to either be a function or a matrix,

Modified: branches/distr-2.5/pkg/distrMod/man/internalmleHelpers.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/internalmleHelpers.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/internalmleHelpers.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -15,7 +15,7 @@
 \usage{
 .negLoglikelihood(x, Distribution, ...)
 .process.meCalcRes(res, PFam, trafo, res.name, call, asvar.fct, check.validity,
-                   ...)
+                   ..., .withEvalAsVar = TRUE)
 .callParamFamParameter(PFam, theta, idx, nuis, fixed)
 }
 
@@ -41,6 +41,9 @@
   \item{idx}{indices of the main part of the component}
   \item{nuis}{nuisance part of the parameter}
   \item{fixed}{fixed part of the parameter}
+  \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
+                   (if \code{asvar.fct} is given) or
+                   just the call be returned?}
 }
 
 \details{

Modified: branches/distr-2.5/pkg/distrMod/man/modifyModel-methods.Rd
===================================================================
--- branches/distr-2.5/pkg/distrMod/man/modifyModel-methods.Rd	2013-02-13 17:04:47 UTC (rev 884)
+++ branches/distr-2.5/pkg/distrMod/man/modifyModel-methods.Rd	2013-02-15 11:42:37 UTC (rev 885)
@@ -32,7 +32,8 @@
   \item{model}{an object of class \code{ParamFamily}  --- the model to move.}
   \item{param}{an object of class \code{ParamFamParameter} --- the parameter to move to.}
   \item{.withCall}{logical: shall slot \code{fam.call} be updated?}
-  \item{.withL2derivDistr}{logical: shall slot \code{L2derivDistr} be updated?}
+  \item{.withL2derivDistr}{logical: shall slot \code{L2derivDistr} be updated or
+                            just the call to do the updated be stored?}
   \item{\dots}{additional argument(s) for methods; not used so far}
 }
 \value{



More information about the Distr-commits mailing list