[Distr-commits] r866 - branches/distr-2.5/pkg/distrMod/R pkg/distrMod/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2013-01-22 14:56:58 +0100 (Tue, 22 Jan 2013)
New Revision: 866

Modified:
   branches/distr-2.5/pkg/distrMod/R/mleCalc-methods.R
   pkg/distrMod/R/mleCalc-methods.R
Log:
distrMod: setMethod("mceCalc", signature(x = "numeric", PFam = "ParamFamily") gains additional calls to makeOKPar() to warrant admissible parameter values

Modified: branches/distr-2.5/pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- branches/distr-2.5/pkg/distrMod/R/mleCalc-methods.R	2013-01-19 00:51:29 UTC (rev 865)
+++ branches/distr-2.5/pkg/distrMod/R/mleCalc-methods.R	2013-01-22 13:56:58 UTC (rev 866)
@@ -84,9 +84,11 @@
            crit.name = "", Infos = NULL, validity.check = TRUE,
            withthetaPar = FALSE, ...){
 
+       mO <- NULL
+       if("makeOkPar" %in% slotNames(class(PFam))) mO <- PFam at makeOKPar
+       if(is.null(mO)) mO <-  function(param)param
+       if(is.null(startPar)) startPar <- mO(startPar(PFam)(x,...))
 
-       if(is.null(startPar)) startPar <- startPar(PFam)(x,...)
-
         lmx <- length(main(PFam))
         lnx <- length(nuisance(PFam))
         fixed <- fixed(PFam)
@@ -100,8 +102,8 @@
                dots$penalty <- NULL
                dots$withBiasC <- NULL
                if(is.function(penalty)) penalty <- penalty(theta)
-               if(!vP) crit0 <- penalty
-               else{
+               if(!vP) {crit0 <- penalty; theta <- mO(theta)
+               }else{
                   if(lnx)
                      names(theta) <- c(names(main(ParamFamily)),
                                        names(nuisance(ParamFamily)))

Modified: pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- pkg/distrMod/R/mleCalc-methods.R	2013-01-19 00:51:29 UTC (rev 865)
+++ pkg/distrMod/R/mleCalc-methods.R	2013-01-22 13:56:58 UTC (rev 866)
@@ -84,9 +84,11 @@
            crit.name = "", Infos = NULL, validity.check = TRUE,
            withthetaPar = FALSE, ...){
 
+       mO <- NULL
+       if("makeOkPar" %in% slotNames(class(PFam))) mO <- PFam at makeOKPar
+       if(is.null(mO)) mO <-  function(param)param
+       if(is.null(startPar)) startPar <- mO(startPar(PFam)(x,...))
 
-       if(is.null(startPar)) startPar <- startPar(PFam)(x,...)
-
         lmx <- length(main(PFam))
         lnx <- length(nuisance(PFam))
         fixed <- fixed(PFam)
@@ -100,8 +102,8 @@
                dots$penalty <- NULL
                dots$withBiasC <- NULL
                if(is.function(penalty)) penalty <- penalty(theta)
-               if(!vP) crit0 <- penalty
-               else{
+               if(!vP) {crit0 <- penalty; theta <- mO(theta)
+               }else{
                   if(lnx)
                      names(theta) <- c(names(main(ParamFamily)),
                                        names(nuisance(ParamFamily)))