[Analogue-commits] r336 - in pkg: . R inst

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

Author: gsimpson
Date: 2013-07-12 00:34:19 +0200 (Fri, 12 Jul 2013)
New Revision: 336

Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/logitreg.R
   pkg/inst/ChangeLog
Log:
add option to use Firth's bias reduced method for logistic regression. Bump to 0.11-4 and adds brglm to Imports

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-07-11 20:32:56 UTC (rev 335)
+++ pkg/DESCRIPTION	2013-07-11 22:34:19 UTC (rev 336)
@@ -1,10 +1,10 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.11-3
+Version: 0.11-4
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), princurve, lattice
-Imports: mgcv, MASS, stats, graphics, grid
+Imports: mgcv, MASS, stats, graphics, grid, brglm
 Author: Gavin L. Simpson, Jari Oksanen
 Maintainer: Gavin L. Simpson <gavin.simpson at uregina.ca>
 Description: Fits Modern Analogue Technique and Weighted Averaging transfer 

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-07-11 20:32:56 UTC (rev 335)
+++ pkg/NAMESPACE	2013-07-11 22:34:19 UTC (rev 336)
@@ -32,6 +32,10 @@
            textGrob,
            unit,
            unit.c)
+## brglm
+importFrom(brglm,
+           brglm,
+           brglm.control)
 
 ## Exports
 export(analog,

Modified: pkg/R/logitreg.R
===================================================================
--- pkg/R/logitreg.R	2013-07-11 20:32:56 UTC (rev 335)
+++ pkg/R/logitreg.R	2013-07-11 22:34:19 UTC (rev 336)
@@ -1,10 +1,17 @@
 `logitreg` <- function(object, groups, k = 1, ...)
     UseMethod("logitreg")
 
-`logitreg.default` <- function(object, groups, k = 1, ...) {
+`logitreg.default` <- function(object, groups, k = 1, biasReduced = FALSE,
+                               ...) {
     if(!is.factor(groups))
         groups <- factor(groups)
     lev <- levels(groups)
+    ## bias reduced fitting via brglm?
+    if(biasReduced) {
+        FIT <- brglm
+    } else {
+        FIT <- glm
+    }
     within <- without <- vector(mode = "list", length = length(lev))
     names(within) <- names(without) <- lev
     models <- vector(mode = "list", length = length(lev) + 1)
@@ -18,8 +25,8 @@
                                 function(x, k) {x[order(x)[k]]}, k = k))
         analogs <- rep(c(TRUE, FALSE), times = c(length(IN), length(OUT)))
         Dij <- c(IN, OUT)
-        models[[l]] <- glm(analogs ~ Dij, data = data.frame(analogs, Dij),
-                           family = binomial(link = "logit"))
+        models[[l]] <- FIT(analogs ~ Dij, data = data.frame(analogs, Dij),
+                           family = binomial(link = "logit"), ...)
         models[[l]]$Dij <- Dij
         within[[l]] <- IN
         without[[l]] <- OUT
@@ -28,9 +35,9 @@
     OUT <- do.call(c, without)
     analogs <- rep(c(TRUE, FALSE), times = c(length(IN), length(OUT)))
     Dij <- c(IN, OUT)
-    models[["Combined"]] <- glm(analogs ~ Dij,
+    models[["Combined"]] <- FIT(analogs ~ Dij,
                                 data = data.frame(analogs, Dij),
-                                family = binomial(link = "logit"))
+                                family = binomial(link = "logit"), ...)
     models[["Combined"]]$Dij <- Dij
     ##class(models) <- "logitreg"
     out <- list(models = models, groups = groups, method = NULL)

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-07-11 20:32:56 UTC (rev 335)
+++ pkg/inst/ChangeLog	2013-07-11 22:34:19 UTC (rev 336)
@@ -1,5 +1,10 @@
 analogue Change Log
 
+Version 0.11-4
+
+	* logitreg: fitting is now possible using Firth's bias reduction
+	technique via the brglm package.
+
 Version 0.11-3
 
 	* chooseTaxa: new argument `value` controls whether the data for