Add of generic AIC and BIc functions for fitdist and fitdistcens objects

lbbe-software · Mar 20, 2024 · 8333635 · 8333635
1 parent 64a87e4
commit 8333635
Show file tree

Hide file tree

Showing 7 changed files with 144 additions and 1 deletion.
diff --git a/NAMESPACE b/NAMESPACE
@@ -20,6 +20,8 @@ S3method(print, quantile.fitdist)
 S3method(print, gofstat.fitdist)
 S3method(quantile, fitdist)
 S3method(logLik, fitdist)
+S3method(AIC, fitdist)
+S3method(BIC, fitdist)
 S3method(vcov, fitdist)
 S3method(coef, fitdist)
 
@@ -32,6 +34,8 @@ S3method(print, summary.fitdistcens)
 S3method(print, quantile.fitdistcens)
 S3method(quantile, fitdistcens)
 S3method(logLik, fitdistcens)
+S3method(AIC, fitdistcens)
+S3method(BIC, fitdistcens)
 S3method(vcov, fitdistcens)
 S3method(coef, fitdistcens)
 export(Surv2fitdistcens)

diff --git a/NEWS.md b/NEWS.md
@@ -12,6 +12,7 @@ NEW FEATURES
 
 - modify or add a initial value for all univariate distributions provided in `actuar`.
 - the `fitdistrplus` git repo now belongs to the `lbbe-software` organization
+- add of generic functions AIC() and BIC() for fitdist and fitdistcens objects.
 
 # fitdistrplus 1.1-11
 

diff --git a/R/AIC.R b/R/AIC.R
@@ -0,0 +1,63 @@
+#############################################################################
+#   Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang                                                                                                  
+#                                                                                                                                                                        
+#   This program is free software; you can redistribute it and/or modify                                               
+#   it under the terms of the GNU General Public License as published by                                         
+#   the Free Software Foundation; either version 2 of the License, or                                                   
+#   (at your option) any later version.                                                                                                            
+#                                                                                                                                                                         
+#   This program is distributed in the hope that it will be useful,                                                             
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of                                          
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the                                 
+#   GNU General Public License for more details.                                                                                    
+#                                                                                                                                                                         
+#   You should have received a copy of the GNU General Public License                                           
+#   along with this program; if not, write to the                                                                                           
+#   Free Software Foundation, Inc.,                                                                                                              
+#   59 Temple Place, Suite 330, Boston, MA 02111-1307, USA                                                             
+#                                                                                                                                                                         
+#############################################################################
+### AIC generic functions
+###
+###         R functions
+###
+
+AIC.fitdist <- function(object, ..., k = 2)
+{
+    stopifnot(inherits(object, "fitdist"))
+
+    if(is.null(object$aic))
+        stop("Internal error in AIC.fitdist")
+    else
+    {
+      if (k == 2) 
+      {
+        return(object$aic)
+      } else
+      {
+        npar <- object$aic / 2 +  object$loglik
+        aic <- -2 * object$loglik + k * npar
+        return(aic)
+      }
+    }
+}
+
+AIC.fitdistcens <- function(object, ..., k = 2)
+{
+    stopifnot(inherits(object, "fitdistcens"))
+
+    if(is.null(object$aic))
+        stop("Internal error in AIC.fitdistcens")
+    else
+    {
+      if (k == 2) 
+      {
+        return(object$aic)
+      } else
+      {
+        npar <- object$aic / 2 +  object$loglik
+        aic <- -2 * object$loglik + k * npar
+        return(aic)
+      }
+    }
+}
diff --git a/R/BIC.R b/R/BIC.R
@@ -0,0 +1,43 @@
+#############################################################################
+#   Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang                                                                                                  
+#                                                                                                                                                                        
+#   This program is free software; you can redistribute it and/or modify                                               
+#   it under the terms of the GNU General Public License as published by                                         
+#   the Free Software Foundation; either version 2 of the License, or                                                   
+#   (at your option) any later version.                                                                                                            
+#                                                                                                                                                                         
+#   This program is distributed in the hope that it will be useful,                                                             
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of                                          
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the                                 
+#   GNU General Public License for more details.                                                                                    
+#                                                                                                                                                                         
+#   You should have received a copy of the GNU General Public License                                           
+#   along with this program; if not, write to the                                                                                           
+#   Free Software Foundation, Inc.,                                                                                                              
+#   59 Temple Place, Suite 330, Boston, MA 02111-1307, USA                                                             
+#                                                                                                                                                                         
+#############################################################################
+### AIC generic functions
+###
+###         R functions
+###
+
+BIC.fitdist <- function(object, ...)
+{
+    stopifnot(inherits(object, "fitdist"))
+
+    if(is.null(object$bic))
+        stop("Internal error in BIC.fitdist")
+    else
+        return(object$bic)
+}
+
+BIC.fitdistcens <- function(object, ...)
+{
+    stopifnot(inherits(object, "fitdistcens"))
+
+    if(is.null(object$bic))
+        stop("Internal error in BIC.fitdistcens")
+    else
+        return(object$bic)
+}
diff --git a/man/fitdist.Rd b/man/fitdist.Rd
@@ -4,6 +4,8 @@
 \alias{print.fitdist}
 \alias{summary.fitdist}
 \alias{logLik.fitdist}
+\alias{AIC.fitdist}
+\alias{BIC.fitdist}
 \alias{vcov.fitdist}
 \alias{coef.fitdist}
 \title{ Fit of univariate distributions to non-censored data}
@@ -14,7 +16,8 @@
  maximizing goodness-of-fit estimation (mge).
  The latter is also known as minimizing distance estimation.
  Generic methods are \code{print}, \code{plot}, 
-\code{summary}, \code{quantile}, \code{logLik}, \code{vcov} and \code{coef}.
+\code{summary}, \code{quantile}, \code{logLik}, \code{AIC}, 
+\code{BIC}, \code{vcov} and \code{coef}.
 }
 
 \usage{
@@ -29,6 +32,10 @@ fitdist(data, distr, method = c("mle", "mme", "qme", "mge", "mse"),
 
 \method{logLik}{fitdist}(object, \dots)
 
+\method{AIC}{fitdist}(object, \dots, k = 2)
+
+\method{BIC}{fitdist}(object, \dots)
+
 \method{vcov}{fitdist}(object, \dots)
 
 \method{coef}{fitdist}(object, \dots)
@@ -71,6 +78,7 @@ fitdist(data, distr, method = c("mle", "mme", "qme", "mge", "mse"),
     with its default breaks definition. Else \code{breaks} is passed to the function \code{hist}.
     This argument is not taken into account with discrete distributions: \code{"binom"}, 
     \code{"nbinom"}, \code{"geom"}, \code{"hyper"} and \code{"pois"}. }
+\item{k}{penalty per parameter to be passed to the AIC generic function (2 by default).}
 \item{\dots}{Further arguments to be passed to generic functions, or to one of the functions
     \code{"mledist"},  \code{"mmedist"}, \code{"qmedist"} or \code{"mgedist"}
     depending of the chosen method. See \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, 
@@ -231,6 +239,10 @@ fitdist(data, distr, method = c("mle", "mme", "qme", "mge", "mse"),
     }
     \item{\code{logLik}}{ Extracts the estimated log-likelihood from the \code{"fitdist"} object.
     }
+    \item{\code{AIC}}{ Extracts the AIC from the \code{"fitdist"} object.
+    }
+    \item{\code{BIC}}{ Extracts the estimated BIC from the \code{"fitdist"} object.
+    }
     \item{\code{vcov}}{ Extracts the estimated var-covariance matrix from the \code{"fitdist"} object
     (only available When \code{method = "mle"}).
     }

diff --git a/man/fitdistcens.Rd b/man/fitdistcens.Rd
@@ -4,6 +4,8 @@
 \alias{print.fitdistcens}
 \alias{summary.fitdistcens}
 \alias{logLik.fitdistcens}
+\alias{AIC.fitdistcens}
+\alias{BIC.fitdistcens}
 \alias{vcov.fitdistcens}
 \alias{coef.fitdistcens}
 \title{Fitting of univariate distributions to censored data}
@@ -24,6 +26,10 @@ fitdistcens(censdata, distr, start=NULL, fix.arg=NULL,
 
 \method{logLik}{fitdistcens}(object, \dots)
 
+\method{AIC}{fitdistcens}(object, \dots, k = 2)
+
+\method{BIC}{fitdistcens}(object, \dots)
+
 \method{vcov}{fitdistcens}(object, \dots)
 
 \method{coef}{fitdistcens}(object, \dots)
@@ -55,6 +61,7 @@ fitdistcens(censdata, distr, start=NULL, fix.arg=NULL,
 otherwise only a sample subset is returned.}
 \item{keepdata.nb}{When \code{keepdata=FALSE}, the length of the subset returned.}
 
+\item{k}{penalty per parameter to be passed to the AIC generic function (2 by default).}
 \item{\dots}{ further arguments to be passed to generic functions,
     to the function \code{plotdistcens} in order to control the type of ecdf-plot used for censored data, 
     or to the function \code{mledist} 
@@ -145,6 +152,10 @@ otherwise only a sample subset is returned.}
     }
     \item{\code{logLik}}{ Extracts the estimated log-likelihood from the \code{"fitdistcens"} object.
     }
+    \item{\code{AIC}}{ Extracts the AIC from the \code{"fitdistcens"} object.
+    }
+    \item{\code{BIC}}{ Extracts the BIC from the \code{"fitdistcens"} object.
+    }
     \item{\code{vcov}}{ Extracts the estimated var-covariance matrix from the \code{"fitdistcens"} object
     (only available When \code{method = "mle"}).
     }

diff --git a/tests/t-logLik-vcov-coef.R b/tests/t-logLik-vcov-coef.R
@@ -9,12 +9,18 @@ fitg <- fitdist(serving, "gamma")
 logLik(fitg)
 vcov(fitg)
 coef(fitg)
+AIC(fitg)
+AIC(fitg, k = log(fitg$n)) # should give BIC
+BIC(fitg)
 
 fitg <- fitdist(serving, "gamma", method="mme")
 
 logLik(fitg)
 vcov(fitg) 
 coef(fitg)
+AIC(fitg)
+AIC(fitg, k = log(fitg$n)) # should give BIC
+BIC(fitg)
 
 # (2) Fit of a lognormal distribution to bacterial contamination data
 #
@@ -23,4 +29,7 @@ fitsf  <-  fitdistcens(smokedfish,"lnorm")
 logLik(fitsf)
 vcov(fitsf) 
 coef(fitsf)
+AIC(fitsf)
+AIC(fitsf, k = log(fitsf$n)) # should give BIC
+BIC(fitsf)