[Distr-commits] r401 - in branches/distr-2.1/pkg/distrMod: R chm man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Feb 19 22:24:32 CET 2009


Author: ruckdeschel
Date: 2009-02-19 22:24:32 +0100 (Thu, 19 Feb 2009)
New Revision: 401

Modified:
   branches/distr-2.1/pkg/distrMod/R/AllPlot.R
   branches/distr-2.1/pkg/distrMod/R/MCEstimator.R
   branches/distr-2.1/pkg/distrMod/R/MDEstimator.R
   branches/distr-2.1/pkg/distrMod/R/MLEstimator.R
   branches/distr-2.1/pkg/distrMod/R/internalMleCalc.R
   branches/distr-2.1/pkg/distrMod/R/mleCalc-methods.R
   branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html
   branches/distr-2.1/pkg/distrMod/chm/distrMod.chm
   branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd
Log:
+ fixed issue with MCE, MLE and MDE also defined for ParamFamily class objects; so they need not have an Information slot
+ fixed issue with cex.inner

Modified: branches/distr-2.1/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -129,11 +129,18 @@
          if (mainL) {
              if(missing(tmar))
                 tmar <- 5
-             if(missing(cex.inner))
-                cex.inner <- .65
              lineT <- 0.6
              }
      }
+     if(missing(cex.inner)){
+        cex.inner <- .65
+        cex.innerD <- 1
+     }else{
+        cex.inner <- rep(cex.inner, length.out=2)
+        cex.innerD <- cex.inner[1]
+        cex.inner <- cex.inner[2]             
+     }
+
      if (hasArg(sub)){
          subL <- TRUE
          if (is.logical(sub)){
@@ -193,7 +200,7 @@
         if(any(distrpl)){
            lis0 <- c(list(e1, withSweave = withSweave, 
                           main = main, inner = innerD, sub = sub, 
-                          col.inner = col.inner, cex.inner = 1.5*cex.inner),
+                          col.inner = col.inner, cex.inner = cex.innerD),
                      dots, mfColRow = mfColRow)
            lis0$to.draw.arg  <- todrw 
            do.call(plot, args = lis0)            

Modified: branches/distr-2.1/pkg/distrMod/R/MCEstimator.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/MCEstimator.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/MCEstimator.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -31,16 +31,22 @@
     ## call to mceCalc
     res0 <- do.call(mceCalc, argList)
     
-
-    ## digesting the results of mceCalc
-    res <- .process.meCalcRes(res0, PFam = ParamFamily, 
+    asv <- if("FisherInfo" %in% slotNames(ParamFamily)){
+              function(ParamFamily, param)
+                                  solve(FisherInfo(ParamFamily, param = param))
+           }else NULL
+    
+    argList <- c(list(res0, PFam = ParamFamily, 
                               trafo = trafo, 
                               res.name = paste("Minimum", crit.name, 
                                                "estimate", sep=" ", collapse=""), 
-                              call = es.call, 
-                              asvar.fct = function(ParamFamily, param)
-                                  solve(FisherInfo(ParamFamily, param = param)),
-                              ...)
+                              call = quote(es.call))) 
 
+    if(!is.null(asv))   argList <- c(argList, asvar.fct = asv)
+    if(!is.null(dots))  argList <- c(argList, dots)
+    
+    ## digesting the results of mceCalc
+    res <- do.call(.process.meCalcRes, argList)
+
     return(res)
 }

Modified: branches/distr-2.1/pkg/distrMod/R/MDEstimator.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/MDEstimator.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/MDEstimator.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -33,12 +33,19 @@
 
     ## digesting the results of mceCalc
     names(res0$criterion) <- dist.name
-    res <- .process.meCalcRes(res0, PFam = ParamFamily, 
+
+    argList <- c(list(res0, PFam = ParamFamily, 
                               trafo = trafo, 
                               res.name = paste("Minimum", dist.name, 
                                                "estimate", sep = " "), 
-                              call = es.call, asvar.fct = asvar.fct, ...)
+                              call = quote(es.call)))
 
+    if(!missing(asvar.fct))   argList <- c(argList, asvar.fct = asvar.fct)
+    if(!is.null(dots))  argList <- c(argList, dots)
+    
+    ## digesting the results of mceCalc
+    res <- do.call(.process.meCalcRes, argList)
+
     return(res)
 }
 

Modified: branches/distr-2.1/pkg/distrMod/R/MLEstimator.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/MLEstimator.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/MLEstimator.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -27,24 +27,25 @@
 
     ## call to mleCalc
     res0 <- do.call(mleCalc, argList)
+
+    asv <- if("FisherInfo" %in% slotNames(ParamFamily)){
+              function(PFam = ParamFamily, param, ...)
+                                  solve(FisherInfo(PFam, param = param))
+           }else NULL
     
-    ## setting asymptotic variance
-    asv.fct <- function(PFam = ParamFamily, param, ...) 
-                        solve(FisherInfo(PFam, param = param))
+    argList <- list(res0, PFam = ParamFamily, trafo = trafo, 
+                      res.name = "Maximum likelihood estimate",
+                      call = quote(es.call)) 
 
+    if(!is.null(asv))   argList <- c(argList, asvar.fct = asv)
+    if(!is.null(dots))  argList <- c(argList, dots)
+    
     ## digesting the results of mceCalc
-    res <- .process.meCalcRes(res0, PFam = ParamFamily, 
-                              trafo = trafo, 
-                              res.name = "Maximum likelihood estimate", 
-                              call = es.call,                               
-                              asvar.fct = asv.fct, 
-                              ...)
-
+    res <- do.call(what = ".process.meCalcRes", args = argList)
     
     names(res at criterion) <- "negative log-likelihood"
     res at estimate.call <- es.call
     res at name <- "Maximum likelihood estimate"
-
     
     return(res)
 }

Modified: branches/distr-2.1/pkg/distrMod/R/internalMleCalc.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/internalMleCalc.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/internalMleCalc.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -28,7 +28,8 @@
     theta <- res$estimate
     crit <- res$criterion
     param <- res$param
-    
+
+
     crit.name <- ""
     if(res$crit.name == ""){
        if(!is.null(names(res$criterion))) 
@@ -81,7 +82,8 @@
 
     asvar <- NULL
     if(!missing(asvar.fct))
-       asvar <- asvar.fct(PFam, param, ...)
+       if(!is.null(asvar.fct))
+           asvar <- asvar.fct(PFam, param, ...)
 
     untransformed.estimate <- theta
     untransformed.asvar <- asvar
@@ -94,14 +96,15 @@
            rownames(asvar) <- colnames(asvar) <- c(names(estimate))
           }
     }
-
-    new("MCEstimate", name = est.name, estimate = estimate, criterion = crit,
-         asvar = asvar, Infos = Infos, samplesize = res$samplesize,
-         nuis.idx = nuis.idx, estimate.call = call, trafo = traf0,
-         untransformed.estimate = untransformed.estimate,
-         untransformed.asvar = untransformed.asvar,
-         criterion.fct = res$crit.fct, method = res$method,
-         fixed = fixed(param))
+    res.me <- new("MCEstimate", name = est.name, estimate = estimate, 
+                  criterion = crit, asvar = asvar, Infos = Infos, 
+                  samplesize = res$samplesize, nuis.idx = nuis.idx, 
+                  estimate.call = call, trafo = traf0,
+                  untransformed.estimate = untransformed.estimate,
+                  untransformed.asvar = untransformed.asvar,
+                  criterion.fct = res$crit.fct, method = res$method,
+                  fixed = fixed(param))
+    return(res.me)
 }
 
 ##########################################################################

Modified: branches/distr-2.1/pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/mleCalc-methods.R	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/R/mleCalc-methods.R	2009-02-19 21:24:32 UTC (rev 401)
@@ -27,7 +27,7 @@
     ##  we produce a function where all coordinates of theta appear as
     ##  separate named arguments, which then calls 'fun' with these
     ##  separate arguments again stacked to one (named) vector argument;
-    ##  to this end note that in S functions and lists can be coerced
+    ##  to this end note that in S, functions and lists can be coerced
     ##  into each other, i.e. as.list(function(x1=3,x2,x3,...){<body>})
     ##  becomes a list of length length(arglist)+1, where the first
     ##  components are just the named arguments, while the last is the body

Modified: branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html
===================================================================
--- branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-02-19 21:24:32 UTC (rev 401)
@@ -195,7 +195,9 @@
 <dt>bmar</dt><dd>bottom margin &ndash; useful for non-standard sub title sizes</dd>
 <dt>cex.inner</dt><dd>magnification to be used for inner titles relative
 to the current setting of <code>cex</code>; as in 
-<code><a onclick="findlink('stats', 'par.html')" style="text-decoration: underline; color: blue; cursor: hand">par</a></code></dd>
+<code><a onclick="findlink('stats', 'par.html')" style="text-decoration: underline; color: blue; cursor: hand">par</a></code>; can be a vector of length 2; in this
+case the first component is for the distribution panels, the 
+second for the L2-derivative-panels.</dd>
 <dt>col.inner</dt><dd>character or integer code; color for the inner title</dd>              
 <dt>mfColRow</dt><dd>shall default partition in panels be used &mdash; 
 defaults to <code>TRUE</code></dd>

Modified: branches/distr-2.1/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd
===================================================================
--- branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd	2009-02-17 17:19:25 UTC (rev 400)
+++ branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd	2009-02-19 21:24:32 UTC (rev 401)
@@ -166,7 +166,9 @@
         \item{bmar}{bottom margin -- useful for non-standard sub title sizes}
         \item{cex.inner}{magnification to be used for inner titles relative
           to the current setting of \code{cex}; as in 
-          \code{\link[stats]{par}}}
+          \code{\link[stats]{par}}; can be a vector of length 2; in this
+          case the first component is for the distribution panels, the 
+          second for the L2-derivative-panels.}
        \item{col.inner}{character or integer code; color for the inner title}              
        \item{mfColRow}{shall default partition in panels be used --- 
                        defaults to \code{TRUE}}



More information about the Distr-commits mailing list