Simulate! Simulate! – Part 4: A binomial generalized linear mixed model

[This article was first published on Very statisticious on Very statisticious, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

A post about simulating data from a generalized linear mixed model (GLMM), the fourth post in my simulations series involving linear models, is long overdue. I settled on a binomial example based on a binomial GLMM with a logit link.

I find binomial models the most difficult to grok, primarily because the model is on the scale of log odds, inference is based on odds, but the response variable is a counted proportion. I use the term counted proportion to indicate that the proportions are based on discrete counts, the total number of “successes” divided by the total number of trials. A different distribution (possibly beta) would be needed for continuous proportions like, e.g., total leaf area with lesions.

Models based on single parameter distributions like the binomial can be overdispersed or underdispersed, where the variance in the data is bigger or smaller, respectively, than the variance defined by the binomial distribution. Given this, I thought exploring estimates of dispersion based on simulated data that we know comes from a binomial distribution would be interesting.

I will be simulating data “manually”. However, also see the simulate() function from package lme4. I find this function particularly useful if I want to simulate data based on a fitted model, but it can also be used in situations where you don’t already have a model.

R packages

I’ll be fitting binomial GLMM with lme4. I use purrr for looping and ggplot2 for plotting results.

library(lme4) # v. 1.1-23
library(purrr) # v. 0.3.4
library(ggplot2) # v. 3.3.2

The statistical model

As usual, I’ll start by writing out the statistical model using mathematical equations. If these aren’t helpful to you, jump down to the code. You may find that writing the code first and coming back to look at the statistical model later is helpful.

The imaginary study design that is the basis of my model has two different sizes of study units. This is a field experiment scenario, where multiple sites within a region are selected and then two plots within each site are randomly placed and a treatment assigned (“treatment” or “control”). You can think of “sites” as a blocking variable. The number of surviving plants from some known total number planted at an earlier time point is measured in each plot.

I first define a response variable that comes from the binomial distribution. (If you haven’t seen this style of statistical model before, my Poisson GLM post goes into slightly more detail.)

\[y_t \thicksim Binomial(p_t, m_t)\]

  • \(y_t\) is the observed number of surviving plants from the total \(m_t\) planted for the \(t\)th plot.
  • \(p_t\) is the unobserved true mean (proportion) of the binomial distribution for the \(t\)th plot.
  • \(m_t\) is the total number of plants originally planted, also know as the total number of trials or the binomial sample size. The binomial sample size can be the same for all plots (likely for experimental data) or vary among plots (more common for observational data).

We assume that the relationship between the mean of the response and explanatory variables is linear on the logit scale so I use a logit link function when writing out the linear predictor. The logit is the same as the log odds; i.e., \(logit(p)\) is the same as \(log(\frac{p}{1-p})\).

The model I define here has a categorical fixed effect with only two levels.

\[logit(p_t) = \beta_0 + \beta_1*I_{(treatment_t=\textit{treatment})} + (b_s)_t\]

  • \(\beta_0\) is the log odds of survival when the treatment is control.
  • \(\beta_1\) is the difference in log odds of survival between the two treatments, treatment minus control.
  • The indicator variable, \(I_{(treatment_t=\textit{treatment})}\), is 1 when the treatment is treatment and 0 otherwise.
  • \(b_s\) is the (random) effect of the \(s\)th site on the log odds of survival. \(s\) goes from 1 to the total number of sites sampled. The site-level random effects are assumed to come from an iid normal distribution with a mean of 0 and some shared, site-level variance, \(\sigma^2_s\): \(b_s \thicksim N(0, \sigma^2_s)\).

If you are newer to generalized linear mixed models you might want to take a moment and note of the absence of epsilon in the linear predictor.

A single simulation for a binomial GLMM

Below is what the dataset I will create via simulation looks like. I have a variable to represent the sites (site) and plots (plot) as well as one for the treatments the plot was assigned to (treatment). In addition, y is the total number of surviving plants, and num_samp is the total number originally planted (50 for all plots in this case).

Note that y/num_samp is the proportion of plants that survived, which is what we are interested in. In binomial models in R you often use the number of successes and the number of failures (total trials minus the number of successes) as the response variable instead of the actual observed proportion.

# # A tibble: 20 x 5
#    site  plot  treatment num_samp     y
#               
#  1 A     A.1   treatment       50    40
#  2 A     A.2   control         50    26
#  3 B     B.1   treatment       50    42
#  4 B     B.2   control         50    23
#  5 C     C.1   treatment       50    48
#  6 C     C.2   control         50    33
#  7 D     D.1   treatment       50    28
#  8 D     D.2   control         50    19
#  9 E     E.1   treatment       50    45
# 10 E     E.2   control         50    35
# 11 F     F.1   treatment       50    45
# 12 F     F.2   control         50    25
# 13 G     G.1   treatment       50    35
# 14 G     G.2   control         50    21
# 15 H     H.1   treatment       50    42
# 16 H     H.2   control         50    26
# 17 I     I.1   treatment       50    47
# 18 I     I.2   control         50    30
# 19 J     J.1   treatment       50    42
# 20 J     J.2   control         50    31

I’ll start the simulation by setting the seed so the results can be exactly reproduced. I always do this for testing my methodology prior to performing many simulations.

set.seed(16)

Defining the difference in treatments

I need to define the “truth” in the simulation by setting all the parameters in the statistical model to values of my choosing. I found it a little hard to figure out what the difference between treatments would be on the scale of the log odds, so I thought it worthwhile to discuss my process here.

I realized it was easier to for me to think about the results in this case in terms of proportions of each treatment and then use those to convert differences between treatments to log odds. I started out by thinking about what I would expect the surviving proportion of plants to be in the control group. I decided I’d expect half to survive, 0.5. The treatment, if effective, needs to improve survival substantially to be cost effective. I decided that treatment group should have at least 85% survival (0.85).

The estimate difference from the model will be expressed as odds, so I calculated the odds and then the difference in odds as an odds ratio based on my chosen proportions per group.

codds = .5/(1 - .5)
todds = .85/(1 - .85)
todds/codds
# [1] 5.666667

Since the model is linear on the scale of log odds I took the log of the odds ratio above to figure out the additive difference between treatments on the model scale.

log(todds/codds)
# [1] 1.734601

I also need the log odds for the control group, since that is what the intercept, \(\beta_0\), represents in my statistical model.

log(codds)
# [1] 0

Here are the values I’ll use for the “truth” today:

  • The true log odds for on the control group, \(\beta_0\), will be 0
  • The difference in log odds of the treatment compared to the control, \(\beta_1\), will be 1.735.
  • The site-level variance (\(\sigma^2_s\)) will be set at 0.5.

I’ll define the number of sites to 10 while I’m at it. Since I’m working with only 2 treatments, there will be 2 plots per site. The total number of plots (and so observations) is the number of sites times the number of plots per site: 10*2 = 20.

b0 = 0
b1 = 1.735
site_var = 0.5
n_sites = 10

Creating the study design variables

Without discussing the code, since I’ve gone over code like this in detail in earlier posts, I will create variables based on the study design, site, plot, and treatment, using rep(). I’m careful to line things up so there are two unique plots in each site, one for each treatment. I don’t technically need the plot variable for the analysis I’m going to do, but I create it to keep myself organized (and to mimic a real dataset 😁).

site = rep(LETTERS[1:n_sites], each = 2)
plot = paste(site, rep(1:2, times = n_sites), sep = "." )
treatment = rep( c("treatment", "control"), times = n_sites)
dat = data.frame(site, plot, treatment)
dat
#    site plot treatment
# 1     A  A.1 treatment
# 2     A  A.2   control
# 3     B  B.1 treatment
# 4     B  B.2   control
# 5     C  C.1 treatment
# 6     C  C.2   control
# 7     D  D.1 treatment
# 8     D  D.2   control
# 9     E  E.1 treatment
# 10    E  E.2   control
# 11    F  F.1 treatment
# 12    F  F.2   control
# 13    G  G.1 treatment
# 14    G  G.2   control
# 15    H  H.1 treatment
# 16    H  H.2   control
# 17    I  I.1 treatment
# 18    I  I.2   control
# 19    J  J.1 treatment
# 20    J  J.2   control

Simulate the random effect

Next I will simulate the site-level random effects. I defined these as \(b_s \thicksim N(0, \sigma^2_s)\), so will randomly draw from a normal distribution with a mean of 0 and a variance of 0.5. Remember that rnorm() in R uses standard deviation, not variance, so I use the square root of site_var.

Since I am have 10 sites I draw 10 values, with each value repeated for each plot present within the site.

( site_eff = rep( rnorm(n = n_sites, 
                        mean = 0, 
                        sd = sqrt(site_var) ), 
                  each = 2) )
#  [1]  0.33687514  0.33687514 -0.08865705 -0.08865705  0.77514191  0.77514191
#  [7] -1.02122414 -1.02122414  0.81163788  0.81163788 -0.33121733 -0.33121733
# [13] -0.71131449 -0.71131449  0.04494560  0.04494560  0.72476507  0.72476507
# [19]  0.40527261  0.40527261

Calculate log odds

I now have fixed values for all parameters, the variable treatment to create the indicator variable, and the simulated effects of sites drawn from the defined distribution. That’s all the pieces I need to calculate the true log odds.

The statistical model

\[logit(p_t) = \beta_0 + \beta_1*I_{(treatment_t=\textit{treatment})} + (b_s)_t\]

is my guide for how to combine these pieces to calculate the log odds, \(logit(p_t)\).

( log_odds = with(dat, b0 + b1*(treatment == "treatment") + site_eff ) )
#  [1]  2.07187514  0.33687514  1.64634295 -0.08865705  2.51014191  0.77514191
#  [7]  0.71377586 -1.02122414  2.54663788  0.81163788  1.40378267 -0.33121733
# [13]  1.02368551 -0.71131449  1.77994560  0.04494560  2.45976507  0.72476507
# [19]  2.14027261  0.40527261

Convert log odds to proportions

I’m getting close to pulling values from the binomial distribution to get my response variable. Remember that I defined \(y_t\) as:
\[y_t \thicksim Binomial(p_t, m_t)\]
Right now I’ve gotten to the point where I have \(logit(p_t)\). To get the true proportions, \(p_t\), I need to inverse-logit the log odds. In R, function plogis() performs the inverse logit.

( prop = plogis(log_odds) )
#  [1] 0.8881394 0.5834313 0.8383962 0.4778502 0.9248498 0.6846321 0.6712349
#  [8] 0.2647890 0.9273473 0.6924584 0.8027835 0.4179445 0.7356899 0.3293085
# [15] 0.8556901 0.5112345 0.9212726 0.6736555 0.8947563 0.5999538

I can’t forget about \(m_t\). I need to know the binomial sample size for each plot before I can calculate the number of successes based on the total number of trials from the binomial distribution. Since my imaginary study is an experiment I will set this as 50 for every plot.

dat$num_samp = 50

I’ve been in situations where I wanted the binomial sample size to vary per observation. In that case, you may find sample() useful, using the range of binomial sample sizes you are interested in as the first argument.

Here’s an example of what that code could look like, allowing the binomial sample size to vary from 40 and 50 for every plot. (Code not run.)

num_samp = sample(40:50, size = 20, replace = TRUE)

Generate the response variable

Now that I have a vector of proportions and have set the binomial sample size per plot, I can calculate the number of successes for each true proportion and binomial sample size based on the binomial distribution. I do this via rbinom().

It is this step where we add the “binomial errors” to the proportions to generate a response variable. The variation for each simulated y value is based on the binomial variance.

The next bit of code is directly based on the distribution defined in the statistical model: \(y_t \thicksim Binomial(p_t, m_t)\). I randomly draw 20 values from the binomial distribution, one for each of the 20 proportions stored in prop. I define the binomial sample size in the size argument.

( dat$y = rbinom(n = n_sites*2, size = dat$num_samp, prob = prop) )
#  [1] 40 26 42 23 48 33 28 19 45 35 45 25 35 21 42 26 47 30 42 31

Fit a model

It’s time for model fitting! I can now fit a binomial generalized linear mixed model with a logit link using, e.g., the glmer() function from package lme4.

mod = glmer(cbind(y, num_samp - y) ~ treatment + (1|site), 
            data = dat,
            family = binomial(link = "logit") )
mod
# Generalized linear mixed model fit by maximum likelihood (Laplace
#   Approximation) [glmerMod]
#  Family: binomial  ( logit )
# Formula: cbind(y, num_samp - y) ~ treatment + (1 | site)
#    Data: dat
#      AIC      BIC   logLik deviance df.resid 
# 122.6154 125.6025 -58.3077 116.6154       17 
# Random effects:
#  Groups Name        Std.Dev.
#  site   (Intercept) 0.4719  
# Number of obs: 20, groups:  site, 10
# Fixed Effects:
#        (Intercept)  treatmenttreatment  
#             0.1576              1.4859

Make a function for the simulation

A single simulation can help us understand the statistical model, but usually the goal of a simulation is to see how the model behaves over the long run. To that end I’ll make my simulation process into a function.

In my function I’m going to set all the arguments to the parameter values as I defined them earlier. I allow some flexibility, though, so the argument values can be changed if I want to explore the simulation with, say, a different number of replications or different parameter values. I do not allow the number of plots to vary in this particular function, since I’m hard-coding in two treatments.

This function returns a generalized linear mixed model fit with glmer().

bin_glmm_fun = function(n_sites = 10,
                        b0 = 0,
                        b1 = 1.735,
                        num_samp = 50,
                        site_var = 0.5) {
     site = rep(LETTERS[1:n_sites], each = 2)
     plot = paste(site, rep(1:2, times = n_sites), sep = "." )
     treatment = rep( c("treatment", "control"), times = n_sites)
     dat = data.frame(site, plot, treatment)           
     
     site_eff = rep( rnorm(n = n_sites, mean = 0, sd = sqrt(site_var) ), each = 2)
     
     log_odds = with(dat, b0 + b1*(treatment == "treatment") + site_eff)
     prop = plogis(log_odds)
     dat$num_samp = num_samp
     dat$y = rbinom(n = n_sites*2, size = num_samp, prob = prop)
     
     glmer(cbind(y, num_samp - y) ~ treatment + (1|site),
           data = dat,
           family = binomial(link = "logit") )
}

I test the function, using the same seed, to make sure things are working as expected and that I get the same results as above. I do, and everything looks good.

set.seed(16)
bin_glmm_fun()
# Generalized linear mixed model fit by maximum likelihood (Laplace
#   Approximation) [glmerMod]
#  Family: binomial  ( logit )
# Formula: cbind(y, num_samp - y) ~ treatment + (1 | site)
#    Data: dat
#      AIC      BIC   logLik deviance df.resid 
# 122.6154 125.6025 -58.3077 116.6154       17 
# Random effects:
#  Groups Name        Std.Dev.
#  site   (Intercept) 0.4719  
# Number of obs: 20, groups:  site, 10
# Fixed Effects:
#        (Intercept)  treatmenttreatment  
#             0.1576              1.4859

Repeat the simulation many times

Now that I have a working function to simulate data and fit the model it’s time to do the simulation many times. The model from each individual simulation is saved to allow exploration of long run model performance.

This is a task for replicate(), which repeatedly calls a function and saves the output. When using simplify = FALSE the output is a list, which is convenient for going through to extract elements from the models later. I’ll re-run the simulation 1000 times. This could take awhile to run for complex models with many terms.

I print the output of the 100th list element so you can see the list is filled with models.

sims = replicate(1000, bin_glmm_fun(), simplify = FALSE )
sims[[100]]
# Generalized linear mixed model fit by maximum likelihood (Laplace
#   Approximation) [glmerMod]
#  Family: binomial  ( logit )
# Formula: cbind(y, num_samp - y) ~ treatment + (1 | site)
#    Data: dat
#      AIC      BIC   logLik deviance df.resid 
# 122.1738 125.1610 -58.0869 116.1738       17 
# Random effects:
#  Groups Name        Std.Dev.
#  site   (Intercept) 0.6059  
# Number of obs: 20, groups:  site, 10
# Fixed Effects:
#        (Intercept)  treatmenttreatment  
#           0.001914            1.824177

Extract results from the binomial GLMM

After running all the models we can extract whatever we are interested in to explore long run behavior. As I was planning this post, I started wondering what the estimate of dispersion would look like from a binomial GLMM that was not over or underdispersed by definition.

With some caveats, which you can read more about in the GLMM FAQ, the sum of the squared Pearson residuals divided by the residual degrees of freedom is an estimate of over/underdispersion. This seems OK to use in the scenario I’ve set up here since my binomial sample sizes are fairly large and my proportions are not too close to the distribution limits.

I made a function to calculate this.

overdisp_fun = function(model) {
     sum( residuals(model, type = "pearson")^2)/df.residual(model)
}
overdisp_fun(mod)
# [1] 0.7169212

Explore estimated dispersion

I want to look at the distribution of dispersion estimates from the 1000 models. This involves looping through the models and using overdisp_fun() to extract the estimated dispersion from each one. I put the result in a data.frame since I’ll be plotting the result with ggplot2. I use purrr helper function map_dfr() for the looping.

alldisp = map_dfr(sims, ~data.frame(disp = overdisp_fun(.x) ) )

Here’s the plot of the resulting distribution. I put a vertical line at 1, since values above 1 indicate overdispersion and below 1 indicate underdispersion.

ggplot(alldisp, aes(x = disp) ) +
     geom_histogram(fill = "blue", 
                    alpha = .25, 
                    bins = 100) +
     geom_vline(xintercept = 1) +
     scale_x_continuous(breaks = seq(0, 2, by = 0.2) ) +
     theme_bw(base_size = 14) +
     labs(x = "Disperson",
          y = "Count")


I’m not sure what to think of this yet, but I am pretty fascinated by the result. Only ~7% of models show any overdispersion.

mean(alldisp$disp > 1)
# [1] 0.069

And hardly any (<0.05%) estimate overdispersion greater than 1.5, which is a high enough value that we would likely be concerned that our results were anti-conservative if this were an analysis of a real dataset.

mean(alldisp$disp > 1.5)
# [1] 0.004

For this scenario, at least, I learned that it is rare to observe substantial overdispersion when the model isn’t overdispersed. That seems useful.

I don’t know why so many models show substantial underdispersion, though. Maybe the method for calculating overdispersion doesn’t work well for underdispersion? I’m not sure.

When checking a real model we’d be using additional tools beyond the estimated dispersion to check model fit and decide if a model looks problematic. I highly recommend package DHARMa for checking model fit for GLMM’s (although I’m not necessarily a fan of all the p-values 😜).

Happy simulating!

Just the code, please

Here’s the code without all the discussion. Copy and paste the code below or you can download an R script of uncommented code from here.

library(lme4) # v. 1.1-23
library(purrr) # v. 0.3.4
library(ggplot2) # v. 3.3.2

dat
set.seed(16)
codds = .5/(1 - .5)
todds = .85/(1 - .85)
todds/codds
log(todds/codds)
log(codds)
b0 = 0
b1 = 1.735
site_var = 0.5
n_sites = 10

site = rep(LETTERS[1:n_sites], each = 2)
plot = paste(site, rep(1:2, times = n_sites), sep = "." )
treatment = rep( c("treatment", "control"), times = n_sites)
dat = data.frame(site, plot, treatment)
dat

( site_eff = rep( rnorm(n = n_sites, 
                        mean = 0, 
                        sd = sqrt(site_var) ), 
                  each = 2) )

( log_odds = with(dat, b0 + b1*(treatment == "treatment") + site_eff ) )
( prop = plogis(log_odds) )

dat$num_samp = 50
num_samp = sample(40:50, size = 20, replace = TRUE)
( dat$y = rbinom(n = n_sites*2, size = dat$num_samp, prob = prop) )

mod = glmer(cbind(y, num_samp - y) ~ treatment + (1|site), 
            data = dat,
            family = binomial(link = "logit") )
mod

bin_glmm_fun = function(n_sites = 10,
                        b0 = 0,
                        b1 = 1.735,
                        num_samp = 50,
                        site_var = 0.5) {
     site = rep(LETTERS[1:n_sites], each = 2)
     plot = paste(site, rep(1:2, times = n_sites), sep = "." )
     treatment = rep( c("treatment", "control"), times = n_sites)
     dat = data.frame(site, plot, treatment)           
     
     site_eff = rep( rnorm(n = n_sites, mean = 0, sd = sqrt(site_var) ), each = 2)
     
     log_odds = with(dat, b0 + b1*(treatment == "treatment") + site_eff)
     prop = plogis(log_odds)
     dat$num_samp = num_samp
     dat$y = rbinom(n = n_sites*2, size = num_samp, prob = prop)
     
     glmer(cbind(y, num_samp - y) ~ treatment + (1|site),
           data = dat,
           family = binomial(link = "logit") )
}


set.seed(16)
bin_glmm_fun()

sims = replicate(1000, bin_glmm_fun(), simplify = FALSE )
sims[[100]]

overdisp_fun = function(model) {
     sum( residuals(model, type = "pearson")^2)/df.residual(model)
}
overdisp_fun(mod)

alldisp = map_dfr(sims, ~data.frame(disp = overdisp_fun(.x) ) )

ggplot(alldisp, aes(x = disp) ) +
     geom_histogram(fill = "blue", 
                    alpha = .25, 
                    bins = 100) +
     geom_vline(xintercept = 1) +
     scale_x_continuous(breaks = seq(0, 2, by = 0.2) ) +
     theme_bw(base_size = 14) +
     labs(x = "Disperson",
          y = "Count")

mean(alldisp$disp > 1)
mean(alldisp$disp > 1.5)

To leave a comment for the author, please follow the link and comment on their blog: Very statisticious on Very statisticious.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)