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

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

Author: ruckdeschel
Date: 2010-05-28 20:35:12 +0200 (Fri, 28 May 2010)
New Revision: 657

Added:
   branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd
Modified:
   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
Log:
introduced NbinomFamily in response to Markus Kalisch's mail to RsR

Modified: branches/distr-2.3/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.3/pkg/distrMod/NAMESPACE	2010-05-19 00:31:55 UTC (rev 656)
+++ branches/distr-2.3/pkg/distrMod/NAMESPACE	2010-05-28 18:35:12 UTC (rev 657)
@@ -64,7 +64,7 @@
        "Estimator", "MCEstimator", "MLEstimator", "MDEstimator")
 export("NonSymmetric", "EvenSymmetric", "OddSymmetric", "FunSymmList") 
 export("ParamFamParameter", "ParamFamily", "L2ParamFamily",
-       "BinomFamily", "PoisFamily", "NormLocationFamily",
+       "BinomFamily", "PoisFamily", "NbinomFamily", "NormLocationFamily",
        "GumbelLocationFamily", "NormScaleFamily", "ExpScaleFamily",
        "LnormScaleFamily", "GammaFamily", "BetaFamily", "NormLocationScaleFamily",
        "CauchyLocationScaleFamily")

Modified: branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R
===================================================================
--- branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R	2010-05-19 00:31:55 UTC (rev 656)
+++ branches/distr-2.3/pkg/distrMod/R/AllReturnClasses.R	2010-05-28 18:35:12 UTC (rev 657)
@@ -16,6 +16,10 @@
 setClass("PoisFamily",
           contains = "L2ParamFamily")
 
+## Binomial family
+setClass("NbinomFamily",
+          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-05-19 00:31:55 UTC (rev 656)
+++ branches/distr-2.3/pkg/distrMod/R/SimpleL2ParamFamilies.R	2010-05-28 18:35:12 UTC (rev 657)
@@ -116,6 +116,64 @@
 }
 
 ##################################################################
+## NegBinomial family
+##################################################################
+NbinomFamily <- function(size = 1, prob = 0.5, trafo){ 
+    name <- "Negative Binomial family"
+    distribution <- Nbinom(size = size, prob = prob)
+    distrSymm <- NoSymmetry()
+    param0 <- prob
+    names(param0) <- "prob"
+    param1 <- size
+    names(param1) <- "size"
+    if(missing(trafo)) trafo <- matrix(1, dimnames = list("prob","prob"))
+    param <- ParamFamParameter(name = "probability of success",  
+                               main = param0, 
+                               fixed = param1, 
+                               trafo = trafo)
+    modifyParam <- function(theta){ Nbinom(size = size, prob = theta) }
+    body(modifyParam) <- substitute({ Nbinom(size = size, prob = theta) }, list(size = size))
+    props <- ""
+    
+    startPar <- function(x,...) c(.Machine$double.eps,1-.Machine$double.eps)
+    makeOKPar <- function(param) {if(param<=0) return(.Machine$double.eps)
+                                  if(param>=1) return(1-.Machine$double.eps)
+                                  return(param)}
+    L2deriv.fct <- function(param){
+                   prob <- main(param)
+                   fct <- function(x){}
+                   body(fct) <- substitute({ (size- (x+size)*prob)/(prob*(1-prob)) },
+                                list(size = size, prob = prob))
+                   return(fct)}
+    L2derivSymm <- FunSymmList(NonSymmetric()) 
+    L2derivDistr <- UnivarDistrList((size-(distribution+size)*prob)/(prob*(1-prob)))
+    L2derivDistrSymm <- DistrSymmList(NoSymmetry())
+    FisherInfo.fct <- function(param){
+                       prob <- main(param)
+                       PosDefSymmMatrix(matrix(size/(prob^2*(1-prob)),
+                           dimnames=list("prob","prob")))}
+
+    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 = "NbinomFamily")
+    if(!is.function(trafo))
+       f.call <- substitute(NbinomFamily(size = s, prob = p,
+  	                     trafo = matrix(Tr, dimnames = list("prob","prob"))),
+  	                     list(s = size, p = prob, Tr = trafo))    
+    else
+       f.call <- substitute(NbnomFamily(size = s, prob = p,
+  	                     trafo = Tr), list(s = size, p = prob, Tr = trafo))    
+    
+    res at fam.call <- f.call
+    return(res)
+}
+
+##################################################################
 ## Gamma family
 ##################################################################
 GammaFamily <- function(scale = 1, shape = 1, trafo){ 

Added: branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd
===================================================================
--- branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd	                        (rev 0)
+++ branches/distr-2.3/pkg/distrMod/man/NBinomFamily.Rd	2010-05-28 18:35:12 UTC (rev 657)
@@ -0,0 +1,41 @@
+\name{NbinomFamily}
+\alias{NbinomFamily}
+
+\title{Generating function for Nbinomial families}
+\description{
+  Generates an object of class \code{"L2ParamFamily"} which
+  represents a Nbinomial family where the probability of
+  success is the parameter of interest.
+}
+\usage{
+NbinomFamily(size = 1, prob = 0.5, trafo)
+}
+\arguments{
+  \item{size}{ number of trials }
+  \item{prob}{ probability of success }
+  \item{trafo}{ function in \code{param} or matrix: transformation of the parameter }
+}
+\details{
+  The slots of the corresponding L2 differentiable 
+  parameteric family are filled.
+}
+\value{Object of class \code{"L2ParamFamily"}}
+\references{
+  Kohl, M. (2005) \emph{Numerical Contributions to the 
+  Asymptotic Theory of Robustness}. Bayreuth: Dissertation.
+
+  Kohl, M. and Ruckdeschel, P. (2010). 
+  R Package distrMod: S4 Classes and Methods for
+  Probability Models. To appear in Journal of Statistical Software.
+}
+\author{Peter Ruckdeschel \email{peter.ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{L2ParamFamily-class}}, \code{\link[distr]{Nbinom-class}}}
+\examples{
+(N1 <- NbinomFamily(size = 25, prob = 0.25))
+plot(N1)
+FisherInfo(N1)
+checkL2deriv(N1)
+}
+\concept{Negative Binomial model}
+\keyword{models}