Simulating data from a fitted generalised linear binomial model - r

Question

I have asked this question on the r-sig-mixed-models mailing list but have received no helpful answers, so I am trying here. Fingers crossed.
I apologise for the length/prolixity of my question, but the structure is complicated and I see no way to shorten my discussion.
Although this is not relevant to the question I am asking, my ultimate objective is to simulate new data from a fitted model, but with the experimental design changed from that of the
data set to which the model was fitted. The changes involve altering the number of replicates (replicates being the underlying random effect) and altering the number of binomial trials associated with each observation. The final goal is to examine, via simulation, the relative impact of the number of replicates and the number of binomial trials on the precision with which a certain (intricate) parameter is estimated.
I am working with the lme4 R package.
I had hoped to be able to adjust the experimental design from which the simulated data are generated by means of the "newdata" argument of the function simulate.merMod(), but I cannot get this to work. I am probably misunderstanding something. I am too slow and stupid to follow the help for simulate.merMod().
Since I could not accomplish my aim with simulate.merMod() I decided to try a roll-your-own approach. The problem here is that I need to be sure that this roll-your-own approach is correct. As a check, I tried comparing the roll-your-own results with results from simulate.merMod() (with seeds set appropriately so that the "random" results should be the same).
Basically my roll-your-own procedure consists of constructing a linear predictor using
* fitted fixed effect coefficients from the fitted model
* random effects simulated on the basis of the fitted
random effects variances and covarances
I then form probabilities as the logistic function of the linear
predictor, and finally use rbinom() to generate a random sample
from these probabilities and the desired "sizes".
I get agreement when there is a single random effect in the model, but I cannot get agreement when there are two random effects, and cannot see what I am doing wrong.
For the single random effect setting I made use of the "cbpp" data set from the lme4 package. The code that I used is as follows:
library(lme4)
fit <- glmer(cbind(incidence, size - incidence) ~ 0 + period + (1 | herd),
family = binomial, data = cbpp)
ccc <- getME(fit,"beta")
sigma <- getME(fit,"theta")
# Roll-your-own:
set.seed(101)
Z <- rnorm(length(levels(cbpp$herd)),0,sigma)
lnpr <- with(cbpp,ccc[period] + Z[herd])
p <- 1/(1+exp(-lnpr))
s.ryo <- rbinom(nrow(cbpp),cbpp$size,p)
# Using simulate.merMod:
set.seed(101)
s.mer <- simulate(fit)
s.mer <- s.mer[,1][,1]
# Check for equality:
print(all.equal(s.ryo,s.mer))
The two simulated results agree exactly.
However the setting in which I am really interested involves two random effects (random intercepts and random "slopes", i.e. random coefficients for the numeric predictor). Following is code that I tried to use in this
setting. In this case I cannot get the results from roll-your-own and simulate.merMod() to agree. The data set that I use in this case is not contained in the lme4 package.
This data set is provided after the illustrative code.
Sorry for the rather extreme length of the display.
I would appreciate any advice as to what I am doing wrong,
and comments as to whether my roll-your-own approach makes any sense at all.
Code:
library(lme4)
fit <- glmer(cbind(Good, Bad) ~ (trtmnt+0)/x + (x | batch),
family = binomial, data = Dat) # See below for "Dat"
ccc <- fixef(fit)
Sigma <- VarCorr(fit)[[1]]
# Roll-your-own:
set.seed(101)
nrep <- length(levels(Dat$batch))
Z <- MASS::mvrnorm(nrep,c(0,0),Sigma)
beta0 <- ccc[1:4][as.numeric(Dat$trtmnt)]
beta1 <- ccc[5:8][as.numeric(Dat$trtmnt)]
lnpr <- with(Dat,beta0 + beta1*x + Z[batch,1] + Z[batch,2]*x)
p <- 1/(1+exp(-lnpr)) # Inverse of logit link.
size <- with(Dat,Good+Bad)
s.ryo <- rbinom(nrow(Dat),size,p)
# Using simulate.merMod:
set.seed(101)
s.mer <- simulate(fit)
s.mer <- s.mer[,1][,1]
# The results are not equal.
Data:
Dat <- structure(list(Good = c(87, 137, 194, 211, 250, 259, 272, 277,
279, 279, 279, 279, 76, 134, 216, 229, 253, 264, 275, 282, 286,
287, 287, 287, 90, 109, 209, 219, 228, 245, 240, 244, 247, 247,
247, 247, 113, 147, 230, 257, 283, 287, 290, 295, 298, 298, 298,
298, 60, 105, 175, 203, 237, 250, 263, 268, 267, 268, 268, 268,
32, 71, 163, 184, 206, 220, 231, 242, 243, 245, 245, 245, 104,
138, 254, 265, 261, 284, 282, 283, 285, 286, 286, 286, 57, 89,
155, 193, 210, 214, 219, 229, 231, 231, 231, 231, 42, 71, 136,
154, 197, 211, 226, 228, 229, 229, 229, 229, 47, 69, 140, 167,
208, 215, 235, 241, 244, 246, 246, 246, 49, 79, 138, 179, 198,
213, 214, 220, 220, 221, 221, 221, 57, 85, 170, 186, 224, 221,
231, 232, 234, 235, 235, 235, 57, 92, 162, 185, 219, 234, 240,
243, 242, 243, 243, 243, 55, 95, 178, 205, 237, 255, 263, 274,
274, 276, 278, 278, 53, 81, 183, 236, 243, 279, 285, 290, 288,
291, 291, 291, 72, 101, 166, 209, 223, 219, 238, 236, 238, 238,
238, 238, 49, 77, 135, 171, 182, 195, 205, 211, 213, 214, 214,
214, 214, 28, 63, 123, 144, 160, 182, 187, 198, 201, 203, 204,
205, 205, 36, 64, 169, 183, 190, 206, 211, 213, 216, 217, 218,
218, 218, 58, 76, 163, 182, 194, 198, 204, 203, 207, 207, 208,
208, 208, 41, 82, 145, 163, 195, 213, 221, 226, 228, 229, 229,
229, 229, 42, 66, 121, 153, 179, 187, 203, 214, 216, 216, 218,
218, 218, 57, 71, 132, 185, 190, 198, 205, 207, 209, 210, 210,
210, 210, 43, 68, 132, 174, 186, 190, 199, 206, 206, 208, 208,
208, 208, 38, 65, 115, 126, 178, 190, 203, 211, 212, 213, 213,
213, 213, 34, 66, 124, 144, 183, 199, 224, 227, 232, 234, 235,
235, 235, 37, 81, 132, 166, 182, 190, 212, 218, 218, 220, 220,
220, 220, 42, 73, 129, 180, 207, 214, 242, 245, 247, 247, 248,
248, 248), Bad = c(192, 142, 85, 68, 29, 20, 7, 2, 0, 0, 0, 0,
211, 153, 71, 58, 34, 23, 12, 5, 1, 0, 0, 0, 157, 138, 38, 28,
19, 2, 7, 3, 0, 0, 0, 0, 185, 151, 68, 41, 15, 11, 8, 3, 0, 0,
0, 0, 208, 163, 93, 65, 31, 18, 5, 0, 1, 0, 0, 0, 213, 174, 82,
61, 39, 25, 14, 3, 2, 0, 0, 0, 182, 148, 32, 21, 25, 2, 4, 3,
1, 0, 0, 0, 174, 142, 76, 38, 21, 17, 12, 2, 0, 0, 0, 0, 187,
158, 93, 75, 32, 18, 3, 1, 0, 0, 0, 0, 199, 177, 106, 79, 38,
31, 11, 5, 2, 0, 0, 0, 172, 142, 83, 42, 23, 8, 7, 1, 1, 0, 0,
0, 178, 150, 65, 49, 11, 14, 4, 3, 1, 0, 0, 0, 186, 151, 81,
58, 24, 9, 3, 0, 1, 0, 0, 0, 223, 183, 100, 73, 41, 23, 15, 4,
4, 2, 0, 0, 238, 210, 108, 55, 48, 12, 6, 1, 3, 0, 0, 0, 166,
137, 72, 29, 15, 19, 0, 2, 0, 0, 0, 0, 165, 137, 79, 43, 32,
19, 9, 3, 1, 0, 0, 0, 0, 177, 142, 82, 61, 45, 23, 18, 7, 4,
2, 1, 0, 0, 182, 154, 49, 35, 28, 12, 7, 5, 2, 1, 0, 0, 0, 150,
132, 45, 26, 14, 10, 4, 5, 1, 1, 0, 0, 0, 188, 147, 84, 66, 34,
16, 8, 3, 1, 0, 0, 0, 0, 176, 152, 97, 65, 39, 31, 15, 4, 2,
2, 0, 0, 0, 153, 139, 78, 25, 20, 12, 5, 3, 1, 0, 0, 0, 0, 165,
140, 76, 34, 22, 18, 9, 2, 2, 0, 0, 0, 0, 175, 148, 98, 87, 35,
23, 10, 2, 1, 0, 0, 0, 0, 201, 169, 111, 91, 52, 36, 11, 8, 3,
1, 0, 0, 0, 183, 139, 88, 54, 38, 30, 8, 2, 2, 0, 0, 0, 0, 206,
175, 119, 68, 41, 34, 6, 3, 1, 1, 0, 0, 0), x = c(1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12,
14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6,
7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9,
10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12,
14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6,
7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9,
10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 16, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8,
9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 16,
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6,
7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14,
16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5,
6, 7, 8, 9, 10, 12, 14, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12,
14, 16), batch = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L,
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L,
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L,
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L), levels = c("1", "2", "3", "4", "5", "6", "7"
), class = "factor"), trtmnt = structure(c(1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L), levels = c("A", "B", "C", "D"), class = "factor")), row.names = c(NA,
348L), class = "data.frame")

Answer 1

tl;dr I believe the results of these different approaches are equivalent (i.e. lead to the same distribution of results); they are not equal because the multivariate Normal values are chosen in a different way.
MASS::mvrnorm() computes the eigenvalues and eigenvectors of the covariance matrix; picks a set of standard Normal deviates; scales them by the square root of the eigenvalues; and multiplies by the eigenvector matrix
lme4::.simulateFun() (the workhorse function behind the simulate() method) computes the Cholesky factor of the covariance matrix of the random effects directly; picks a set of standard Normal deviates; and multiplies
For a simple case, #RolfTurner's roll-your-own code is much easier to understand; the advantage of the more abstract approach used in .simulateFun(), illustrated further below, is that it generalizes to an arbitrarily complex random effects model (multiple random effects, complicated vector-valued REs, etc.) without any further tweaking.
These two approaches give the same distributions, but not precisely the same answer (I hope that's convincing at a mathematical level: I don't really want to get farther into the details of exactly which linear combinations of standard normal deviates are used, or whether it's possible to permute the standard-normal-deviate vector so these two approaches are equivalent at the level of computed values, not just distributions ...)
Here is a simplified illustration of the two deviate-generation processes:
Sigma <- VarCorr(fit)[[1]]
set.seed(102)
b1 <- MASS::mvrnorm(1, mu = rep(0, 2), Sigma = Sigma)
## (Intercept) x
## -0.04550951 -0.01789231
set.seed(101)
b2 <- drop(t(chol(Sigma)) %*% rnorm(2))
## (Intercept) x
## -0.08147349 0.01498128
Here is (approximately) the code that lme4::.simulateFun uses internally (the code for MASS::mvrnorm() is much shorter and easier to read).
set.seed(101)
nsim <- 1
newRE <- mkNewReTrms(fit, newdata = Dat, ~x|batch)
## Lambdat is the (transpose of) the Cholesky factor of the RE covariance matrix
## Zt is the (transpose of) the RE model matrix
## (equivalent to converting the `Z[batch,]` vector to `Z[batch,1] + Z[batch,2]*x`)
U <- t(newRE$Lambdat %*% newRE$Zt)
u <- rnorm(ncol(U) * nsim)
b2 <- drop(as(U %*% matrix(u, ncol = nsim), "matrix"))
Here is an experimental demonstration (not proof) that the results are equivalent: simulate 500 draws using each approach and plot them against each other:
## NOT standalone: needs the code in the original post to be run first
ryo_fun <- function() {
b <- MASS::mvrnorm(nrep,c(0,0), Sigma)
lnpr <- with(Dat,beta0 + beta1*x + b[batch,1] + b[batch,2]*x)
p <- 1/(1+exp(-lnpr)) # Inverse of logit link.
size <- with(Dat,Good+Bad)
s.ryo <- rbinom(nrow(Dat),size,p)
return(s.ryo)
}
set.seed(101)
ryo_mat <- replicate(500, ryo_fun())
# Using simulate.merMod:
set.seed(101)
mer_mat <- sapply(simulate(fit, nsim = 500), function(x) x[,1])
png("SO73439211.png")
par(las=1, bty = "l")
plot(ryo_mat, mer_mat, col = adjustcolor("black", alpha.f = 0.1), pch = 16,
xlab = "roll your own", ylab = "simulate()")
abline(a=0, b=1, col = 2, lwd = 2)
dev.off()