---
author: "[Ioannis Kosmidis](http://www.ikosmidis.com)"
title: "Bias-reduced logistic regression for the maize data"
date: 2021-09-05
---

## Necessary packages
```{r}
library("brglm2")
library("detectseparation")
```

## Introduction
Daniel J. Eck <dje13@illinois.edu> sent the maize data set to Ioannis
Kosmidis <ioannis.kosmidis@warwick.ac.uk> on 2021-09-03 03:54. In the
current note we attempt to reproduce the analysis that led to the
results in Table 2 of the manuscript ["Robust model-based estimation
for binary outcomes in genomics studies"](./manuscript-draft.pdf) by
Suyoung Park, Alexander E. Lipka, and Daniel J. Eck, in terms of the
**brglm2** behaviour.

## Maize data
The maize data set has been delivered in the file
`"Combined_Final_Product.csv"`, which is different than the
`"Combined_Final_Product.xlsx"`, which is used in the technical report
["Technical Report for Robust model-based estimation for binary
outcomes in genomics studies"](./technical-report-draft.pdf), which
reproduces the results in the manuscript.

Here we assume that `"Combined_Final_Product.csv"` has exactly the
same data as `"Combined_Final_Product.xlsx"`

```{r}
corn_dat <- read.csv("Combined_Final_Product.csv")
```

and we apply the same transformations as in the technical report
```{r}
names(corn_dat)[c(10, 8)] <- c("Kernel.color","Pop.structure")
Xind <- 11:ncol(corn_dat)
foo <- corn_dat[, c(10,8,Xind[-c(15,19,22,23,24)])]
foo$Pop.structure <- factor(foo$Pop.structure)
dat <- data.frame(foo)
dat[,-c(1,2)] <- scale(dat[,-c(1,2)]) #scale the data
```

## Fitting

### Maximum likelihood

Fitting the logistic regression model in the technical report on the
maize data using maximum likelihood reports warnings about fitted
probabilities on the boundary

```{r}
corn_fm <- Kernel.color ~ .
mod_ml <- glm(corn_fm , data = dat, family = "binomial")
coef(mod_ml)
```

A simple check for separation shows that data separation occurs and
that several maximum likelihood estimates are infinite.

```{r}
update(mod_ml, method = "detect_separation")
```

## Firth's bias-reducing adjusted score equations

A solution to the issues associated to infinite maximum likelihood
estimates is to estimate the model using Firth's bias-reducing
adjusted score equations. An implementation of that is provided by the
**brglm2** R package.

Solving the adjusted score equations with the default optimization
tuning parameters (see `?brglmFit`) returns a warning for boundary
fitted probabilities, and estimates that seem to diverge.

```{r}
system.time(mod_br <- update(mod_ml, method = "brglm_fit"))
coef(mod_br)
```

This should not be possible according to the theoretical results in
Kosmidis & Firth (2021, <http://doi.org/10.1093/biomet/asaa052>),
which show that the reduced-bias estimates (which is equivalent to
maximum penalized likelihood with Jeffreys-prior penalty) are always
finite. So, there most probably have been issues with the default
turning of the **brglm2** optimization procedure and / or the default
starting values.

By default, **brglm2** uses as starting values the maximum likelihood
estimates after adding `length(coef(mod_ml)) / nrow(dat)` (here 
`r length(coef(mod_ml)) / nrow(dat)`) to the binomial responses and
totals.

Alternative starting values can be obtained using
`response_adjustment`, which sets alternative values for what is added
to the responses. For example, with a bit more shrinkage towards, we
seem to overcome the issues that the defaults had with this particular
data set.

```{r}
system.time(mod_br <- update(mod_ml, method = "brglm_fit", response_adjustment = 0.05))
summary(mod_br)
```

The maximum absolute value of the adjusted score functions at the
estimates shown above is `r max(abs(mod_br$grad), na.rm = TRUE)`. This
is close to zero as it should, and we can get closer by setting
stricter stopping criteria. 

Overall, the user can control all sorts of aspects of the optimization
algorithm (quasi-Fisher scoring; see Kosmidis et al, 2020,
<https://doi.org/10.1007/s11222-019-09860-6> or the **brglm2**
vignettes), or even directly supply starting values using the `start`
argument.
