[Distr-commits] r1253 - in branches/distr-2.8/pkg/distrMod: R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Aug 6 08:28:03 CEST 2018


Author: ruckdeschel
Date: 2018-08-06 08:28:02 +0200 (Mon, 06 Aug 2018)
New Revision: 1253

Modified:
   branches/distr-2.8/pkg/distrMod/R/AllShow.R
   branches/distr-2.8/pkg/distrMod/R/MCEstimator.R
   branches/distr-2.8/pkg/distrMod/R/MDEstimator.R
   branches/distr-2.8/pkg/distrMod/R/MLEstimator.R
   branches/distr-2.8/pkg/distrMod/inst/NEWS
   branches/distr-2.8/pkg/distrMod/man/MCEstimator.Rd
   branches/distr-2.8/pkg/distrMod/man/MDEstimator.Rd
   branches/distr-2.8/pkg/distrMod/man/MLEstimator.Rd
Log:
[distrMod] branch 2.8: 

+ show-method for ParamWithShapeFamParameter and MCEstimate did unnecessary casting to superclasses
  hence hid the true class
+ argument distance did not show it came from CvMDist, CvMDist2 via CvMMDEstiamtor when unparsed -- 
  now the unparsed argument in CvMMDEstimator is called CvMDist0 so shows that it is related to 
+ for later purposes (in RobAStBase to use this to autmatically append pIC information to
  CvMMDEs and MLEs), .checkEstClassForParamFamily has to "see" the L2Family, so has to be called
  from the top layer -> controlled by .with.checkEstClassForParamFamily (also a possible
  point to save time during evaluation ...) 


Modified: branches/distr-2.8/pkg/distrMod/R/AllShow.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/AllShow.R	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/R/AllShow.R	2018-08-06 06:28:02 UTC (rev 1253)
@@ -82,7 +82,7 @@
 
 setMethod("show", "ParamWithShapeFamParameter",
     function(object){
-       show(as(object,"ParamFamParameter"))
+       getMethod("show","ParamFamParameter")(object)
        if(object at withPosRestr)
           cat(gettext("Shape parameter must not be negative.\n"))
 })
@@ -259,7 +259,7 @@
 setMethod("show", "MCEstimate", 
     function(object){
        digits <- getOption("digits")
-       show(as(object,"Estimate"))
+        getMethod("show", "Estimate")(object)
        if(getdistrModOption("show.details")!="minimal"){
         cat("Criterion:\n")
         print(criterion(object), quote = FALSE)}

Modified: branches/distr-2.8/pkg/distrMod/R/MCEstimator.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/MCEstimator.R	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/R/MCEstimator.R	2018-08-06 06:28:02 UTC (rev 1253)
@@ -5,7 +5,7 @@
                         startPar = NULL, 
                         Infos, trafo = NULL, penalty = 1e20, validity.check = TRUE,
                         asvar.fct, na.rm = TRUE, ..., .withEvalAsVar = TRUE,
-                        nmsffx = ""){
+                        nmsffx = "", .with.checkEstClassForParamFamily = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -60,6 +60,7 @@
     ## digesting the results of mceCalc
     res <- do.call(.process.meCalcRes, argList)
     res at completecases <- completecases
-    
-    return(.checkEstClassForParamFamily(ParamFamily,res))
+    if(.with.checkEstClassForParamFamily)
+       res <- .checkEstClassForParamFamily(ParamFamily,res)
+    return(res)
 }

Modified: branches/distr-2.8/pkg/distrMod/R/MDEstimator.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/MDEstimator.R	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/R/MDEstimator.R	2018-08-06 06:28:02 UTC (rev 1253)
@@ -6,7 +6,8 @@
                         startPar = NULL,  Infos, 
                         trafo = NULL, penalty = 1e20,
                         validity.check = TRUE, asvar.fct, na.rm = TRUE,
-                        ..., .withEvalAsVar = TRUE, nmsffx = ""){
+                        ..., .withEvalAsVar = TRUE, nmsffx = "",
+                        .with.checkEstClassForParamFamily = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -47,7 +48,7 @@
     }
 
     toClass <- "MDEstimate"
-    if(distfc %in% c("CvMDist", "CvMDist2")) toClass <- "CvMMDEstimate"
+    if(distfc %in% c("CvMDist", "CvMDist2", "CvMDist0")) toClass <- "CvMMDEstimate"
 
     if(paramDepDist) dots$thetaPar <-NULL
 
@@ -88,7 +89,9 @@
     res <- do.call(.process.meCalcRes, argList)
 
     res at completecases <- completecases
-    return(.checkEstClassForParamFamily(ParamFamily,res))
+    if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
+    return(res)
 }
 
 CvMMDEstimator <- function(x, ParamFamily, muDatOrMod = c("Dat","Mod", "Other"),
@@ -98,23 +101,23 @@
                            trafo = NULL, penalty = 1e20,
                            validity.check = TRUE, asvar.fct = .CvMMDCovariance, 
                            na.rm = TRUE, ..., .withEvalAsVar = TRUE,
-                           nmsffx = ""){
+                           nmsffx = "", .with.checkEstClassForParamFamily = TRUE){
 
   muDatOrMod <- match.arg(muDatOrMod)
   if(muDatOrMod=="Dat") {
-     distance0 <- CvMDist
+     CvMDist0 <- CvMDist
      estnsffx <- "( mu = emp. cdf )"
      if(missing(asvar.fct)) asvar.fct <- .CvMMDCovarianceWithMux
   }else{
      if(muDatOrMod=="Mod") {
-        distance0 <- CvMDist2
+        CvMDist0 <- CvMDist2
         estnsffx <- "( mu = model distr. )"
         if(missing(asvar.fct)) asvar.fct <- .CvMMDCovariance
      }else{
         if(missing(mu)||is.null(mu))
            stop(gettextf("This choice of 'muDatOrMod' requires a non-null 'mu'"))
         muc <- paste(deparse(substitute(mu)))
-        distance0 <- function(e1,e2,... ) CvMDist(e1, e2, mu = mu, ...)
+        CvMDist0 <- function(e1,e2,... ) CvMDist(e1, e2, mu = mu, ...)
         estnsffx <- paste("( mu = ", muc, ")")
         if(missing(asvar.fct))
             asvar.fct <- function(L2Fam, param, N = 400, rel.tol=.Machine$double.eps^0.3,
@@ -127,14 +130,17 @@
      }
   }
 
-  res <- MDEstimator(x = x, ParamFamily = ParamFamily, distance = distance0,
+  res <- MDEstimator(x = x, ParamFamily = ParamFamily, distance = CvMDist0,
               paramDepDist = paramDepDist, startPar = startPar,  Infos = Infos,
               trafo = trafo, penalty = penalty, validity.check = validity.check,
               asvar.fct = asvar.fct, na.rm = na.rm,
-              ..., .withEvalAsVar = .withEvalAsVar)
+              ..., .withEvalAsVar = .withEvalAsVar,
+              .with.checkEstClassForParamFamily = FALSE)
 #  print(list(estnsffx, nmsffx))
   res at name <- paste("Minimum CvM distance estimate", estnsffx, nmsffx, collapse="")
   res at estimate.call <- match.call()
+  if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
   return(res)
 }
 
@@ -142,13 +148,17 @@
                            startPar = NULL, Infos,
                            trafo = NULL, penalty = 1e20,
                            validity.check = TRUE, asvar.fct, na.rm = TRUE, ...,
-                           .withEvalAsVar = TRUE, nmsffx = ""){
+                           .withEvalAsVar = TRUE, nmsffx = "",
+                           .with.checkEstClassForParamFamily = TRUE){
   res <- MDEstimator(x = x, ParamFamily = ParamFamily, distance = KolmogorovDist,
               paramDepDist = paramDepDist, startPar = startPar,  Infos = Infos,
               trafo = trafo, penalty = penalty, validity.check = validity.check,
               asvar.fct = asvar.fct, na.rm = na.rm,
-              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx)
+              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx,
+              .with.checkEstClassForParamFamily = FALSE)
   res at estimate.call <- match.call()
+  if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
   return(res)
 }
 
@@ -156,13 +166,17 @@
                            startPar = NULL, Infos,
                            trafo = NULL, penalty = 1e20,
                            validity.check = TRUE, asvar.fct, na.rm = TRUE, ...,
-                           .withEvalAsVar = TRUE, nmsffx = ""){
+                           .withEvalAsVar = TRUE, nmsffx = "",
+                           .with.checkEstClassForParamFamily = TRUE){
   res <- MDEstimator(x = x, ParamFamily = ParamFamily, distance = TotalVarDist,
               paramDepDist = paramDepDist, startPar = startPar,  Infos = Infos,
               trafo = trafo, penalty = penalty, validity.check = validity.check,
               asvar.fct = asvar.fct, na.rm = na.rm,
-              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx)
+              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx,
+              .with.checkEstClassForParamFamily = FALSE)
   res at estimate.call <- match.call()
+  if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
   return(res)
 }
 
@@ -170,13 +184,17 @@
                            startPar = NULL, Infos,
                            trafo = NULL, penalty = 1e20,
                            validity.check = TRUE, asvar.fct, na.rm = TRUE, ...,
-                           .withEvalAsVar = TRUE, nmsffx = ""){
+                           .withEvalAsVar = TRUE, nmsffx = "",
+                           .with.checkEstClassForParamFamily = TRUE){
   res <- MDEstimator(x = x, ParamFamily = ParamFamily, distance = HellingerDist,
               paramDepDist = paramDepDist, startPar = startPar,  Infos = Infos,
               trafo = trafo, penalty = penalty, validity.check = validity.check,
               asvar.fct = asvar.fct, na.rm = na.rm,
-              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx)
+              ..., .withEvalAsVar = .withEvalAsVar, nmsffx = nmsffx,
+              .with.checkEstClassForParamFamily = FALSE)
   res at estimate.call <- match.call()
+  if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
   return(res)
 }
 

Modified: branches/distr-2.8/pkg/distrMod/R/MLEstimator.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/MLEstimator.R	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/R/MLEstimator.R	2018-08-06 06:28:02 UTC (rev 1253)
@@ -9,7 +9,7 @@
                         validity.check = TRUE, na.rm = TRUE,
                         ..., .withEvalAsVar = TRUE,
                         dropZeroDensity = TRUE,
-                        nmsffx = ""){
+                        nmsffx = "", .with.checkEstClassForParamFamily = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -61,5 +61,8 @@
     res at name <- "Maximum likelihood estimate"
     res at completecases <- completecases
     
-    return(.checkEstClassForParamFamily(ParamFamily,res))
+    if(.with.checkEstClassForParamFamily)
+         res <- .checkEstClassForParamFamily(ParamFamily,res)
+
+    return(res)
 }

Modified: branches/distr-2.8/pkg/distrMod/inst/NEWS
===================================================================
--- branches/distr-2.8/pkg/distrMod/inst/NEWS	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/inst/NEWS	2018-08-06 06:28:02 UTC (rev 1253)
@@ -43,7 +43,12 @@
   the asyCov was using mu the current best fit model distribution 
 + in the wrappers to MDEstimator: CvMMDEstimator, KolmogorovMDEstimator, TotalVarMDEstimator, 
   HellingerMDEstimator, we had the "wrong" call in slot estimate.call
-
++ show-method for ParamWithShapeFamParameter and MCEstimate did unnecessary casting to superclasses
+  hence hid the true class
++ argument distance did not show it came from CvMDist, CvMDist2 via CvMMDEstiamtor when unparsed -- 
+  now the unparsed argument in CvMMDEstimator is called CvMDist0 so shows that it is related to 
+  CvMDist 
+  
 under the hood:
 
 + As this is more for internal purposes, example code for the parsing of dots argument 

Modified: branches/distr-2.8/pkg/distrMod/man/MCEstimator.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/MCEstimator.Rd	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/man/MCEstimator.Rd	2018-08-06 06:28:02 UTC (rev 1253)
@@ -14,7 +14,8 @@
 MCEstimator(x, ParamFamily, criterion, crit.name, 
             startPar = NULL, Infos, trafo = NULL, 
             penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE,
-            ..., .withEvalAsVar = TRUE, nmsffx = "")
+            ..., .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 }
 \arguments{
   \item{x}{ (empirical) data }
@@ -46,6 +47,10 @@
                    (if \code{asvar.fct} is given) or
                    just the call be returned?}
   \item{nmsffx}{character: a potential suffix to be appended to the estimator name.}
+  \item{.with.checkEstClassForParamFamily}{logical: Should a the end of the
+     function \code{.checkEstClassForParamFamily}; defaults to \code{TRUE};
+     can be switched off for computational time or because this is already
+     checked in a calling wrapper function.}
 }
 \details{
   The argument \code{criterion} has to be a function with arguments the 

Modified: branches/distr-2.8/pkg/distrMod/man/MDEstimator.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/MDEstimator.Rd	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/man/MDEstimator.Rd	2018-08-06 06:28:02 UTC (rev 1253)
@@ -15,21 +15,26 @@
 MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name, 
             paramDepDist = FALSE, startPar = NULL, Infos, trafo = NULL,
             penalty = 1e20, validity.check = TRUE, asvar.fct, na.rm = TRUE,
-            ..., .withEvalAsVar = TRUE, nmsffx = "")
+            ..., .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 CvMMDEstimator(x, ParamFamily, muDatOrMod = c("Dat","Mod", "Other"),
             mu = NULL, paramDepDist = FALSE, startPar = NULL, Infos,
             trafo = NULL, penalty = 1e20, validity.check = TRUE, 
             asvar.fct = .CvMMDCovariance, na.rm = TRUE, ...,
-            .withEvalAsVar = TRUE, nmsffx = "")
+            .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 KolmogorovMDEstimator(x, ParamFamily, paramDepDist = FALSE, startPar = NULL, Infos, 
             trafo = NULL, penalty = 1e20, validity.check = TRUE, asvar.fct, 
-            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "")
+            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 TotalVarMDEstimator(x, ParamFamily, paramDepDist = FALSE, startPar = NULL, Infos, 
             trafo = NULL, penalty = 1e20, validity.check = TRUE, asvar.fct, 
-            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "")
+            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 HellingerMDEstimator(x, ParamFamily, paramDepDist = FALSE, startPar = NULL, Infos, 
             trafo = NULL, penalty = 1e20, validity.check = TRUE, asvar.fct, 
-            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "")
+            na.rm = TRUE, ..., .withEvalAsVar = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 CvMDist2(e1,e2,... )
 }
 %- maybe also 'usage' for other objects documented here.
@@ -85,6 +90,10 @@
   \item{nmsffx}{character: a potential suffix to be appended to the estimator name.}
   \item{e1}{object of class \code{"Distribution"} or class \code{"numeric"} }
   \item{e2}{object of class \code{"Distribution"} }
+  \item{.with.checkEstClassForParamFamily}{logical: Should a the end of the
+     function \code{.checkEstClassForParamFamily}; defaults to \code{TRUE};
+     can be switched off for computational time or because this is already
+     checked in a calling wrapper function.}
 }
 \details{
   The argument \code{distance} has to be a (generic) function with arguments 

Modified: branches/distr-2.8/pkg/distrMod/man/MLEstimator.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/MLEstimator.Rd	2018-08-06 02:10:35 UTC (rev 1252)
+++ branches/distr-2.8/pkg/distrMod/man/MLEstimator.Rd	2018-08-06 06:28:02 UTC (rev 1253)
@@ -12,7 +12,8 @@
 MLEstimator(x, ParamFamily, startPar = NULL, 
             Infos, trafo = NULL, penalty = 1e20,
             validity.check = TRUE, na.rm = TRUE, ...,
-            .withEvalAsVar = TRUE, dropZeroDensity = TRUE, nmsffx = "")
+            .withEvalAsVar = TRUE, dropZeroDensity = TRUE, nmsffx = "",
+            .with.checkEstClassForParamFamily = TRUE)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -40,6 +41,10 @@
      density zero be dropped? Optimizers like \code{optim} require finite
      values, so get problems when negative loglikelihood is evaluated. }
   \item{nmsffx}{character: a potential suffix to be appended to the estimator name.}
+  \item{.with.checkEstClassForParamFamily}{logical: Should a the end of the
+     function \code{.checkEstClassForParamFamily}; defaults to \code{TRUE};
+     can be switched off for computational time or because this is already
+     checked in a calling wrapper function.}
 }
 \details{
   The function uses \code{\link{mleCalc}}



More information about the Distr-commits mailing list