[Distr-commits] r665 - in branches/distr-2.3/pkg: distr distr/R distr/man distrMod distrMod/R distrMod/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jul 12 19:00:28 CEST 2010


Author: ruckdeschel
Date: 2010-07-12 19:00:27 +0200 (Mon, 12 Jul 2010)
New Revision: 665

Added:
   branches/distr-2.3/pkg/distr/R/igamma.R
   branches/distr-2.3/pkg/distr/man/igamma.Rd
Modified:
   branches/distr-2.3/pkg/distr/NAMESPACE
   branches/distr-2.3/pkg/distr/R/AllGenerics.R
   branches/distr-2.3/pkg/distr/R/ContDistribution.R
   branches/distr-2.3/pkg/distr/R/DiscreteDistribution.R
   branches/distr-2.3/pkg/distr/man/AbscontDistribution-class.Rd
   branches/distr-2.3/pkg/distr/man/DiscreteDistribution-class.Rd
   branches/distr-2.3/pkg/distr/man/Math-methods.Rd
   branches/distr-2.3/pkg/distrMod/NAMESPACE
   branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R
   branches/distr-2.3/pkg/distrMod/R/SimpleL2ParamFamilies.R
   branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd
Log:
introduced igammaintroduced igamma, the inverse of digamma and corresponding transformations;
also now allow 2-parametric model Nbinom (see SimpleL2ParamFamilies.R...)


Modified: branches/distr-2.3/pkg/distr/NAMESPACE
===================================================================
--- branches/distr-2.3/pkg/distr/NAMESPACE	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/NAMESPACE	2010-07-12 17:00:27 UTC (rev 665)
@@ -64,7 +64,7 @@
               "shape1", "shape1<-", "shape2", "shape2<-", 
               "size", "size<-", "support", "initialize", 
               "print", "plot", "+", "-", "/", "*", "coerce",
-              "Math", "log", "log10", "gamma", "lgamma", 
+              "Math", "log", "log10", "gamma", "lgamma", "digamma", 
               "dim", "show", "convpow", "pivot", "sign",
               "lattice", "width", "Length", "pivot<-", 
               "width<-", "Length<-", "liesInSupport",
@@ -91,5 +91,5 @@
 export("PosDefSymmMatrix","PosSemDefSymmMatrix")
 export("NoSymmetry", "EllipticalSymmetry", "SphericalSymmetry",
        "DistrSymmList") 
-export("qqbounds")
+export("qqbounds","igamma")
 exportMethods("qqplot")

Modified: branches/distr-2.3/pkg/distr/R/AllGenerics.R
===================================================================
--- branches/distr-2.3/pkg/distr/R/AllGenerics.R	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/R/AllGenerics.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -320,7 +320,7 @@
 if(!isGeneric("setgaps"))
    setGeneric("setgaps", function(object, ...) standardGeneric("setgaps"))
 
-#### generics for log, log10, lgamma, gamma
+#### generics for log, log10, lgamma, gamma, digamma
 
 
 if(getRversion()<'2.9.0'){
@@ -330,6 +330,8 @@
    setGeneric("log10")
 if(!isGeneric("lgamma"))
    setGeneric("lgamma")
+if(!isGeneric("digamma"))
+   setGeneric("digamma")
 if(!isGeneric("gamma"))
    setGeneric("gamma")
 if(!isGeneric("sign"))

Modified: branches/distr-2.3/pkg/distr/R/ContDistribution.R
===================================================================
--- branches/distr-2.3/pkg/distr/R/ContDistribution.R	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/R/ContDistribution.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -587,9 +587,56 @@
 
 
 
+setMethod("digamma", "AbscontDistribution",
+          function(x){
+            rnew <-  function(n, ...){}
+            body(rnew) <- substitute({ digamma(g(n, ...)) }, list(g = x at r))
+            px0 <- p(x)(0)
+            if(px0>0) stop("argument of 'digamma' must be concentrated on positive values")
+            xx <- x
+                    
+            pnew <- function(q, lower.tail = TRUE, log.p = FALSE){
+                    iq <- igamma(q) 
+                    px <- p(xx)(iq, lower.tail = lower.tail, log.p = log.p)
+                    return(px)
+            }
+            dnew <- function(x, log = FALSE){
+                    ix <- igamma(x)
+                    dx <- d(xx)(ix, log = log)
+                    nx <- trigamma(ix)
+                    if(log) dx <- dx - log(nx)
+                    else dx <- dx/nx
+                    return(dx)
+            }
+            
+            .x <- sort(c(qexp(unique(pmin(seq(0,1,length=5e4)+1e-10,1-1e-10))),
+                       -abs(rnorm(1e4)),
+                       qcauchy(seq(0.999,1-1e-10,length=5e3),lower.tail=FALSE)))
+            i <- 0; x0 <- 1
+            while(pnew(x0,lower.tail = FALSE)>  getdistrOption("TruncQuantile") && i < 20) 
+                 x0 <- x0 * 2
+             up1 <- x0
+            i <- 0; x0 <- -1
+            while(pnew(x0)> getdistrOption("TruncQuantile") && i < 20) 
+                 x0 <- x0 * 2
+             low1 <- x0
+          
+
+            
+            qnew <- .P2Q(p = pnew, xx =.x,
+                         ql = low1, qu=up1,  
+                         ngrid = getdistrOption("DefaultNrGridPoints"),
+                            qL = -Inf, qU = Inf)
+ 
+            
+            object <- AbscontDistribution( r = rnew, d = dnew, p = pnew, q=qnew,
+                           .withSim = TRUE, .withArith = TRUE, .logExact = FALSE)
+            object
+          })
+
 setMethod("lgamma", "AbscontDistribution",
           function(x){
-            rnew = function(n, ...){}
+            rnew <- function(n, ...){}
             body(rnew) <- substitute({ lgamma(g(n, ...)) }, list(g = x at r))
             object <- AbscontDistribution( r = rnew,
                            .withSim = TRUE, .withArith = TRUE)
@@ -598,7 +645,7 @@
 
 setMethod("gamma", "AbscontDistribution",
           function(x){
-            rnew = function(n, ...){}
+            rnew <- function(n, ...){}
             body(rnew) <- substitute({ gamma(g(n, ...)) }, list(g = x at r))
             object <- AbscontDistribution( r = rnew,
                            .withSim = TRUE, .withArith = TRUE)

Modified: branches/distr-2.3/pkg/distr/R/DiscreteDistribution.R
===================================================================
--- branches/distr-2.3/pkg/distr/R/DiscreteDistribution.R	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/R/DiscreteDistribution.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -519,6 +519,19 @@
           })
 
 
+setMethod("digamma", "DiscreteDistribution",
+          function(x){
+            px0 <- p(x)(0)
+            if(px0>0) stop("argument of 'digamma' must be concentrated on positive values")
+            rnew <-  function(n, ...){}
+            body(rnew) <- substitute({ digamma(g(n, ...)) }, list(g = x at r))
+            
+            object <- DiscreteDistribution( 
+                     supp=digamma(support(x)), 
+                     prob=prob(x), .withArith = TRUE)
+            object
+          })
+
 setMethod("lgamma", "DiscreteDistribution",
           function(x){
             rnew = function(n, ...){}

Added: branches/distr-2.3/pkg/distr/R/igamma.R
===================================================================
--- branches/distr-2.3/pkg/distr/R/igamma.R	                        (rev 0)
+++ branches/distr-2.3/pkg/distr/R/igamma.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -0,0 +1,8 @@
+### defines the inverse function of digamma called igamma for simplicity
+
+## an extensive grid of x-values
+.xg <- sort(c(10^(-70:-1),qexp(unique(pmin(seq(0,1,length=5e5)+1e-10,1-1e-10))),qcauchy(seq(0.999,1-1e-10,length=5e5))))
+.dxg <- digamma(.xg)
+igamma <- approxfun(.dxg,.xg)
+rm(.xg,.dxg)
+

Modified: branches/distr-2.3/pkg/distr/man/AbscontDistribution-class.Rd
===================================================================
--- branches/distr-2.3/pkg/distr/man/AbscontDistribution-class.Rd	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/man/AbscontDistribution-class.Rd	2010-07-12 17:00:27 UTC (rev 665)
@@ -69,6 +69,7 @@
       \item \code{log10}: \code{signature(x = "AbscontDistribution")}:  exact image distribution of \code{log10(x)}.
       \item \code{gamma}: \code{signature(x = "AbscontDistribution")}:  exact image distribution of \code{gamma(x)}.
       \item \code{lgamma}: \code{signature(x = "AbscontDistribution")}:  exact image distribution of \code{lgamma(x)}.
+      \item \code{digamma}: \code{signature(x = "AbscontDistribution")}:  exact image distribution of \code{digamma(x)}.
       \item \code{sqrt}: \code{signature(x = "AbscontDistribution")}:  exact image distribution of \code{sqrt(x)}.
     }}
     \item{-}{\code{signature(e1 = "AbscontDistribution")}: application of `-' to this absolutely continuous distribution.}

Modified: branches/distr-2.3/pkg/distr/man/DiscreteDistribution-class.Rd
===================================================================
--- branches/distr-2.3/pkg/distr/man/DiscreteDistribution-class.Rd	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/man/DiscreteDistribution-class.Rd	2010-07-12 17:00:27 UTC (rev 665)
@@ -59,6 +59,7 @@
       \item \code{log10}: \code{signature(x = "DiscreteDistribution")}:  exact image distribution of \code{log10(x)}.
       \item \code{gamma}: \code{signature(x = "DiscreteDistribution")}:  exact image distribution of \code{gamma(x)}.
       \item \code{lgamma}: \code{signature(x = "DiscreteDistribution")}:  exact image distribution of \code{lgamma(x)}.
+      \item \code{digamma}: \code{signature(x = "DiscreteDistribution")}:  exact image distribution of \code{digamma(x)}.
     }}
     \item{-}{\code{signature(e1 = "DiscreteDistribution")}: application of `-' to this discrete distribution}
     \item{*}{\code{signature(e1 = "DiscreteDistribution", e2 = "numeric")}: multiplication of this discrete distribution

Modified: branches/distr-2.3/pkg/distr/man/Math-methods.Rd
===================================================================
--- branches/distr-2.3/pkg/distr/man/Math-methods.Rd	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distr/man/Math-methods.Rd	2010-07-12 17:00:27 UTC (rev 665)
@@ -19,6 +19,8 @@
 \alias{sign,DiscreteDistribution-method}
 \alias{log10,AbscontDistribution-method}
 \alias{log10,DiscreteDistribution-method}
+\alias{digamma,AbscontDistribution-method}
+\alias{digamma,DiscreteDistribution-method}
 \alias{lgamma,AbscontDistribution-method}
 \alias{lgamma,DiscreteDistribution-method}
 \alias{gamma,AbscontDistribution-method}
@@ -31,11 +33,11 @@
     \item{Math}{\code{signature(x = "AbscontDistribution")}: application of a
       mathematical function from group \code{\link[methods:S4groupGeneric]{Math}}, e.g.
       \code{sin} or \code{exp}  (including
-      \code{log, log10, gamma, lgamma}), to this
+      \code{log, log10, gamma, lgamma, digamma}), to this
       absolutely continouos distribution}
     \item{Math}{\code{signature(x = "DiscreteDistribution")}: application of a
       mathematical function, e.g. sin or exp  (including
-      \code{log, log10, gamma, lgamma}), to this
+      \code{log, log10, gamma, lgamma, digamma}), to this
       discrete distribution}
     \item{Math}{\code{signature(x = "UnivarLebDecDistribution")}: application of a
       mathematical function from group \code{\link[methods:S4groupGeneric]{Math}}, e.g.

Added: branches/distr-2.3/pkg/distr/man/igamma.Rd
===================================================================
--- branches/distr-2.3/pkg/distr/man/igamma.Rd	                        (rev 0)
+++ branches/distr-2.3/pkg/distr/man/igamma.Rd	2010-07-12 17:00:27 UTC (rev 665)
@@ -0,0 +1,27 @@
+\name{igamma}
+\alias{igamma}
+
+\title{Inverse of the digamma function}
+\description{
+  Function \code{igamma} is a numerical inverse of \code{digamma}.
+}
+\usage{
+igamma(x)
+}
+\arguments{
+  \item{x}{ a numeric in the range [-100000,18] }
+  }
+\details{
+\code{igamma} is vectorized;  it is won
+  by spline inversion of a grid; it works well for range 
+  [digamma(1e-5);digamma(1e8)] or [-100000,18].
+}
+\value{\code{igamma(x)} is a value \code{u} such that \code{digamma(u} is approximately \code{x}.}
+\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{digamma}}
+\examples{
+igamma(digamma(c(1e-4,1,20,1e8)))
+}
+\keyword{math}
+

Modified: branches/distr-2.3/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.3/pkg/distrMod/NAMESPACE	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distrMod/NAMESPACE	2010-07-12 17:00:27 UTC (rev 665)
@@ -67,7 +67,7 @@
        "BinomFamily", "PoisFamily", "NbinomFamily", "NormLocationFamily",
        "GumbelLocationFamily", "NormScaleFamily", "ExpScaleFamily",
        "LnormScaleFamily", "GammaFamily", "BetaFamily", "NormLocationScaleFamily",
-       "CauchyLocationScaleFamily")
+       "CauchyLocationScaleFamily", "NbinomwithSizeFamily", "NbinomMeanSizeFamily" )
 export("asCov", "trAsCov", "asHampel", "asBias", "asMSE", "asUnOvShoot", 
        "fiCov", "trFiCov", "fiHampel", "fiMSE", "fiBias", "fiUnOvShoot")
 export("positiveBias", "negativeBias", "symmetricBias", 

Modified: branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R
===================================================================
--- branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -16,10 +16,17 @@
 setClass("PoisFamily",
           contains = "L2ParamFamily")
 
-## Binomial family
+## neg.Binomial family
 setClass("NbinomFamily",
           contains = "L2ParamFamily")
 
+## neg.Binomial family with size
+setClass("NbinomwithSizeFamily",
+          contains = "L2ParamFamily")
+## neg.Binomial family in different parametrization
+setClass("NbinomMeanSizeFamily",
+          contains = "L2ParamFamily")
+
 ## Gamma family
 setClass("GammaFamily",
           contains = "L2ParamFamily")

Modified: branches/distr-2.3/pkg/distrMod/R/SimpleL2ParamFamilies.R
===================================================================
--- branches/distr-2.3/pkg/distrMod/R/SimpleL2ParamFamilies.R	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distrMod/R/SimpleL2ParamFamilies.R	2010-07-12 17:00:27 UTC (rev 665)
@@ -173,6 +173,163 @@
     return(res)
 }
 
+
+NbinomwithSizeFamily <- function(size = 1, prob = 0.5, trafo){ 
+    name <- "Negative Binomial family"
+    distribution <- Nbinom(size = size, prob = prob)
+    distrSymm <- NoSymmetry()
+    param0 <- c(size,prob)
+    names(param0) <- nms <- c("size","prob")
+    if(missing(trafo)) trafo <- matrix(c(1,0,0,1),2,2, dimnames = list(c("size","prob"),c("size","prob")))
+    param <- ParamFamParameter(name = "NegBinomParameter",  
+                               main = param0, 
+                               trafo = trafo)
+    modifyParam <- function(theta){ Nbinom(size = theta[1], prob = theta[2]) }
+    body(modifyParam) <- substitute({ Nbinom(size = theta[1], prob = theta[2]) })
+    props <- ""
+    
+    startPar <- function(x,...){ param1 <- c(1,0.5)
+                                 names(param1) <- c("size","prob")
+                                 return(param1)}
+    makeOKPar <- function(param) {if(param["prob"]<=0) param["prob"] <- .Machine$double.eps
+                                  if(param["prob"]>=1) param["prob"] <- (1-.Machine$double.eps)
+                                  param["size"] <- min(1e-8, param["size"])
+                                  return(param)}
+    L2deriv.fct <- function(param){
+                   prob <- main(param)["prob"]
+                   size <- main(param)["size"]
+                   fct1 <- function(x){}
+                   fct2 <- function(x){}
+                   body(fct2) <- substitute({ (size/prob- x/(1-prob)) },
+                                list(size = size, prob = prob))
+                   body(fct1) <- substitute({ digamma(x+size)-digamma(size)-log(prob)},
+                                list(size = size, prob = prob))
+                   return(list(fct1, fct2))}
+
+    L2derivSymm <- FunSymmList(NonSymmetric(), NonSymmetric())
+    L2derivDistr <- UnivarDistrList( digamma(distribution+size)-digamma(size)-log(prob), 
+                                    (size/prob- distribution/(1-prob)))
+    L2derivDistrSymm <- DistrSymmList(NoSymmetry(), NoSymmetry())
+
+    FisherInfo.fct <- function(param){
+                   prob <- main(param)["prob"]
+                   size <- main(param)["size"]
+                   xn <- 0:min(max(support(distribution)),
+                               qnbinom(1e-6,size=size,prob=prob,lower=FALSE),
+                               1e5)
+                   I11 <- -sum((trigamma(xn+size)-trigamma(size))*dnbinom(xn,size=size,prob=prob))
+                   I12 <- -1/prob
+                   I22 <- size/prob^2/(1-prob)
+                   PosDefSymmMatrix(matrix(c(I11,I12,I12,I22),2,2,
+                           dimnames=list(nms,nms)))}
+
+    FisherInfo <- FisherInfo.fct(param)
+    res <- L2ParamFamily(name = name, distribution = distribution, 
+        distrSymm = distrSymm, param = param, modifyParam = modifyParam,
+        props = props, L2deriv.fct = L2deriv.fct, L2derivSymm = L2derivSymm,
+        L2derivDistr = L2derivDistr, L2derivDistrSymm = L2derivDistrSymm,
+        FisherInfo.fct = FisherInfo.fct, FisherInfo = FisherInfo,
+        startPar = startPar, makeOKPar = makeOKPar, 
+        .returnClsName = "NbinomwithSizeFamily")
+    if(!is.function(trafo))
+       f.call <- substitute(NbinomwithSizeFamily(size = s, prob = p,
+  	                     trafo = matrix(Tr, dimnames = DN)),
+  	                     list(s = size, p = prob, Tr = trafo,
+                         DN = list(nms,nms)))    
+    else
+       f.call <- substitute(NbnomwithSizeFamily(size = s, prob = p,
+  	                     trafo = Tr), list(s = size, p = prob, Tr = trafo))    
+    
+    res at fam.call <- f.call
+    return(res)
+}
+
+NbinomMeanSizeFamily <- function(size = 1, mean = 0.5, trafo){ 
+    name <- "Negative Binomial family"
+    prob.0 <- size/(size+mean)
+    distribution <- Nbinom(size = size, prob = size/(size+mean))
+    distrSymm <- NoSymmetry()
+    param0 <- c(size,mean)
+    names(param0) <- nms <- c("size","mean")
+    if(missing(trafo)) trafo <- matrix(c(1,0,0,1),2,2, dimnames = list(nms,nms))
+    param <- ParamFamParameter(name = "probability of success",  
+                               main = param0, 
+                               trafo = trafo)
+    modifyParam <- function(theta){ Nbinom(size = theta[1], mean = theta[2]) }
+    body(modifyParam) <- substitute({ Nbinom(size = theta[1], mean = theta[2]) })
+    props <- ""
+    
+    startPar <- function(x,...){ param1 <- c(1,0.5)
+                                 names(param1) <- c("size","mean")
+                                 return(param1)}
+    makeOKPar <- function(param) {if(param["mean"]<=0) param["mean"] <- .Machine$double.eps
+                                  if(param["mean"]>=1) param["mean"] <- (1-.Machine$double.eps)
+                                  param["size"] <- min(1e-8, param["size"])
+                                  return(param)}
+    L2deriv.fct <- function(param){
+                   size.0 <- main(param)["size"]
+                   mean.0 <- main(param)["mean"]
+                   prob.0 <- size.0/(size.0+mean.0)
+                   
+                   fct1 <- function(x){}
+                   fct1.2 <- function(x){}
+                   fct2 <- function(x){}
+                   body(fct1) <- substitute({ trigamma(x+size)-trigamma(size)-log(prob.2)},
+                                list(size = size.0, prob.2 = prob.0))
+                   body(fct1.2)<- substitute({ (size/prob.2- x/(1-prob.2)) },
+                                list(size = size.0, prob.2 = prob.0))
+                   body(fct2)  <- substitute({ (1/prob.2-1)* fct1(x) - size/prob.2^2 * fct1.2(x)},
+                                list(size = size.0, prob.2 = prob.0))
+                   return(list(fct1, fct2))}
+    L2derivSymm <- FunSymmList(NonSymmetric(), NonSymmetric())
+
+    .di1 <- function(x)  digamma(x+size)-digamma(size)-log(prob.0)
+    .di2 <- function(x) .di1(x)*(1/prob.0-1)+ (size/prob.0- x/(1-prob.0))*size/prob.0^2 
+    .supp1 <- support(distribution)
+    .supp0 <- .di2(.supp1)
+    .prob1 <- aggregate(data.frame(prob(as(distribution,"DiscreteDistribution"))),
+                 by=list(round(.supp0,5)),sum)[,2]
+    .Di2 <- DiscreteDistribution( supp=.supp0, prob=.prob1, .withArith = TRUE)
+    L2derivDistr <- UnivarDistrList( digamma(distribution+size)-digamma(size)-log(prob.0), 
+                                     .Di2)
+                                     
+    L2derivDistrSymm <- DistrSymmList(NoSymmetry(), NoSymmetry())
+    FisherInfo.fct <- function(param){
+                   mean <- main(param)["mean"]
+                   size <- main(param)["size"]
+                   prob.0 <- size/(size+mean)
+                   xn <- 0:min(max(support(distribution)),
+                               qnbinom(1e-6,size=size,prob=prob.0,lower=FALSE),
+                               1e5)
+                   I11 <- -sum((trigamma(xn+size)-trigamma(size))*dnbinom(xn,size=size,prob=prob.0))
+                   I12 <- -1/prob.0
+                   I22 <- size/prob.0^2/(1-prob.0)
+                   D.m <- matrix(c(1,1/prob.0-1,0,-size/prob.0^2),2,2)
+                   ma  <- D.m%*%matrix(c(I11,I12,I12,I22),2,2)%*%t(D.m)
+                   dimnames(ma) <- list(nms,nms)
+                   PosDefSymmMatrix(ma)}
+
+    FisherInfo <- FisherInfo.fct(param)
+    res <- L2ParamFamily(name = name, distribution = distribution, 
+        distrSymm = distrSymm, param = param, modifyParam = modifyParam,
+        props = props, L2deriv.fct = L2deriv.fct, L2derivSymm = L2derivSymm,
+        L2derivDistr = L2derivDistr, L2derivDistrSymm = L2derivDistrSymm,
+        FisherInfo.fct = FisherInfo.fct, FisherInfo = FisherInfo,
+        startPar = startPar, makeOKPar = makeOKPar, 
+        .returnClsName = "NbinomMeanSizeFamily")
+    if(!is.function(trafo)){
+       f.call <- substitute(NbinomMeanSizeFamily(size = s, mean = m,
+  	                     trafo = matrix(Tr, dimnames = DN)),
+  	                     list(s = size, m = mean, Tr = trafo, DN = list(nms,nms)))    
+    }else{
+       f.call <- substitute(NbinomMeanSizeFamily(size = s, mean = m,
+  	                     trafo = Tr), list(s = size, m= mean, Tr = trafo))    
+    
+    }
+    res at fam.call <- f.call
+    return(res)
+}
+
 ##################################################################
 ## Gamma family
 ##################################################################

Modified: branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd
===================================================================
--- branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd	2010-07-09 18:43:29 UTC (rev 664)
+++ branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd	2010-07-12 17:00:27 UTC (rev 665)
@@ -1,5 +1,7 @@
 \name{NbinomFamily}
 \alias{NbinomFamily}
+\alias{NbinomwithSizeFamily}
+\alias{NbinomMeanSizeFamily}
 
 \title{Generating function for Nbinomial families}
 \description{
@@ -9,6 +11,8 @@
 }
 \usage{
 NbinomFamily(size = 1, prob = 0.5, trafo)
+NbinomwithSizeFamily(size = 1, prob = 0.5, trafo)
+NbinomMeanSizeFamily(size = 1, mean = 0.5, trafo){ 
 }
 \arguments{
   \item{size}{ number of trials }
@@ -18,6 +22,11 @@
 \details{
   The slots of the corresponding L2 differentiable 
   parameteric family are filled.
+  \code{NbinomFamily} assumes \code{size} to be known; while
+  for \code{NbinomwithSizeFamily} it is a second (unknown) parameter;
+  for \code{NbinomMeanSizeFamily} is like \code{NbinomwithSizeFamily}
+  but uses the \code{size,mean} parametrization instead of the
+  \code{size,prob} one.  
 }
 \value{Object of class \code{"L2ParamFamily"}}
 \references{
@@ -36,6 +45,10 @@
 plot(N1)
 FisherInfo(N1)
 checkL2deriv(N1)
+(N1.w <- NbinomwithSizeFamily(size = 25, prob = 0.25))
+plot(N1.w)
+FisherInfo(N1.w)
+checkL2deriv(N1.w)
 }
 \concept{Negative Binomial model}
 \keyword{models}



More information about the Distr-commits mailing list