if (FALSE) {
## demonstrate how to fit a beta-binomial model
## generate some fake data
phi <- 0.7
n <- 300
z <- rnorm(n, sd = 0.2)
ntrials <- sample(1:10, n, replace = TRUE)
eta <- 1 + z
mu <- exp(eta) / (1 + exp(eta))
a <- mu * phi
b <- (1 - mu) * phi
p <- rbeta(n, a, b)
y <- rbinom(n, ntrials, p)
dat <- data.frame(y, z, ntrials)
# define a custom family
beta_binomial2 <- custom_family(
"beta_binomial2", dpars = c("mu", "phi"),
links = c("logit", "log"), lb = c(NA, 0),
type = "int", vars = "vint1[n]"
)
# define the corresponding Stan density function
stan_density <- "
real beta_binomial2_lpmf(int y, real mu, real phi, int N) {
return beta_binomial_lpmf(y | N, mu * phi, (1 - mu) * phi);
}
"
stanvars <- stanvar(scode = stan_density, block = "functions")
# fit the model
fit <- brm(y | vint(ntrials) ~ z, data = dat,
family = beta_binomial2, stanvars = stanvars)
summary(fit)
# define a *vectorized* custom family (no loop over observations)
# notice also that 'vint' no longer has an observation index
beta_binomial2_vec <- custom_family(
"beta_binomial2", dpars = c("mu", "phi"),
links = c("logit", "log"), lb = c(NA, 0),
type = "int", vars = "vint1", loop = FALSE
)
# define the corresponding Stan density function
stan_density_vec <- "
real beta_binomial2_lpmf(int[] y, vector mu, real phi, int[] N) {
return beta_binomial_lpmf(y | N, mu * phi, (1 - mu) * phi);
}
"
stanvars_vec <- stanvar(scode = stan_density_vec, block = "functions")
# fit the model
fit_vec <- brm(y | vint(ntrials) ~ z, data = dat,
family = beta_binomial2_vec,
stanvars = stanvars_vec)
summary(fit_vec)
}
Run the code above in your browser using DataLab