pacman::p_load("ape", "coda", "tidyverse", "here",
"MCMCglmm", "brms", "MASS",
"phytools", "arm", "posterior")A step-by-step tutorial
This online tutorial accompanies the paper “Promoting the use of phylogenetic multinomial generalised mixed-effects model to understand the evolution of discrete traits.”
Introduction
This tutorial provides a step-by-step guide to model different types of variables using MCMCglmm and brms. We show and explain how to implement Gaussian, binary, ordinal, and nominal models and how to interpret the results. We also provide an extension: models with multiple data points per species, fitted to simulated data. Simulation is a powerful tool for understanding the behaviour of a model and the effect of the prior distribution on the results.
Why use phylogenetic comparative methods?
Phylogenetic comparative methods are used to account for the non-independence among species due to shared evolutionary history. If we ignore the phylogenetic relationship among species, we may violate the assumption of independence and underestimate the standard errors of the estimated parameters. These methods are widely used in evolutionary biology and ecology to test hypotheses about the evolution of traits and behaviours, reconstruct common ancestral traits, and investigate how different traits have co-evolved across species.
Why use MCMCglmm and brms in this tutorial?
MCMCglmm and brms allow us to fit hierarchical and nonlinear models. We can create more appropriate models that accurately reflect the underlying relationships within the data. Additionally, both packages can handle various types of response variables, including continuous, Poisson, binary, ordinal, and nominal data. Using Bayesian methods for parameter estimation, MCMCglmm and brms can incorporate prior distributions, which is particularly beneficial when working with limited data.
Intended audience
Our tutorial is designed for students and researchers who have at least basic familiarity with the R language and have an interest in using phylogenetic comparative methods. Although the examples in our tutorial focus on questions and data from Behavioural Ecology and Evolutionary Biology, we provide detailed explanations. Therefore, we believe these techniques are versatile and can be applied in other scientific disciplines, such as environmental science, psychology, and beyond.
Set up R on your computer
Please install the following packages before running the code: MCMCglmm, brms, ape, phytools, here, coda, MASS, tidyverse, arm. brms fits models with Stan, so it needs a working Stan backend: either rstan (the default; see the rstan installation instructions) or cmdstanr (see the cmdstanr website). If this is your first time using brms, please install and test one of these backends first.
Note 1: Some models (especially nominal models) take a long time to run. We therefore recommend saving each fitted model as an .rds file with saveRDS() and reloading it with readRDS() when you want to inspect or compare the results. This is also how this tutorial is rendered: the model-fitting chunks are shown but not run, and the precomputed model objects are loaded from .rds files in a (hidden) chunk before the results are shown.
Note 2: Because of the stochastic nature of MCMC, every time you (re)run a model you will get slightly different output, even when the model mixes well and has converged. Even if you run the same model on the same computer, your output will differ slightly from the output shown here (unless you fix the random seed).
Note 3: As a practical target, we aim for an effective sample size (ESS) above 400 for the parameters we report, following Vehtari et al. (2021), who suggest that this is typically enough for stable estimates of posterior means, quantiles and Monte Carlo standard errors when chains are sampling well. ESS is parameter-specific, and a large ESS alone does not establish that a model has converged. We therefore look at ESS together with other diagnostics: the rank-normalised R-hat (Rhat) computed from multiple chains, trace and autocorrelation plots, Monte Carlo error and, for Stan (brms), divergent transitions and other sampler warnings.
Note 4: For every MCMCglmm model we run four independent chains (the same model, data, priors and MCMC settings, each with its own random seed), so that convergence can be assessed by comparing chains. We check the rank-normalised Rhat and the bulk and tail effective sample sizes across chains, and we report posterior summaries (means and 95% equal-tailed credible intervals) from the pooled draws of all four chains. Derived quantities (e.g. variance proportions, correlations, probabilities and c2-corrected estimates) are calculated for every pooled draw before summarising. The helper functions below implement this; brms runs four chains by default (chains = 4).
# Run the same MCMCglmm model as independent chains, one seed per chain.
run_mcmcglmm_chains <- function(..., seeds) {
lapply(seeds, function(seed) {
set.seed(seed)
MCMCglmm(..., verbose = FALSE)
})
}
# Pool the draws of one component ("Sol", "VCV" or "CP") across chains.
pool_chains <- function(fits, what = "Sol") {
coda::mcmc(do.call(rbind, lapply(fits, function(m) as.matrix(m[[what]]))))
}
# Keep the chains separate (for trace plots and autocorrelation plots).
chains_list <- function(fits, what = "Sol") {
coda::mcmc.list(lapply(fits, function(m) m[[what]]))
}
# Posterior summaries from the pooled draws (mean, SD, 95% equal-tailed interval)
# and between-chain diagnostics (R-hat, bulk and tail ESS) for each parameter.
# Fixed (non-estimated) parameters have SD = 0 and no diagnostics.
summarise_chains <- function(fits, what = c("Sol", "VCV", "CP")) {
what <- what[vapply(what, function(w) !is.null(fits[[1]][[w]]), logical(1))]
out <- do.call(rbind, lapply(what, function(w) {
draws <- posterior::as_draws_array(chains_list(fits, w))
posterior::summarise_draws(draws, "mean", "sd", ~quantile(.x, c(0.025, 0.975)),
"rhat", "ess_bulk", "ess_tail")
}))
out <- as.data.frame(out)
names(out) <- c("parameter", "mean", "sd", "Q2.5", "Q97.5", "rhat", "ess_bulk", "ess_tail")
out[2:5] <- lapply(out[2:5], signif, digits = 4)
out$rhat <- round(out$rhat, 3)
out[7:8] <- lapply(out[7:8], round)
out
}1. Gaussian models
Gaussian models are used when the response variable is continuous (numeric) and its conditional distribution (i.e. the residual variation around the model’s predictions) can be modelled as normal; the raw response itself does not need to be exactly normally distributed. For example, age, body size (e.g. weight, length, or height of an organism), temperature, and distance.
Explanation of dataset
We use the rodent dataset and phylogenetic tree provided by Sheard et al. (2024) to explain how to model Gaussian models. The data is about the rodent suborder Sciuromorpha (223 species), which includes squirrels, chipmunks, dormice, and the mountain beaver. The dataset contains information including tail length, body mass, mean annual temperature, and the presence of a contrasting tail tip (a white or black tip at the end of the tail). In this section, we test the evolutionary relationships between tail length and body mass (response variables) and mean annual temperature and the presence of a contrasting tail tip (predictor variables) in rodents.
First of all, we modify the original dataset.
# 1. Read dataset
dt <- read.csv(here("data", "potential", "Rodent_tail", "RodentData.csv")) # Replace with your own folder path to where the data is stored
str(dt) # check the structure of the dataset
dt <- dt %>% rename(Phylo = UphamTreeName.full) # Rename the 'UphamTreeName.full' column to 'Phylo'
dt <- dt %>% filter(Suborder == "Sciuromorpha") # Filter the rodent suborder
dt <- subset(dt, !is.na(Mass)) # Remove species that do not have body mass data
# Tail length and body mass: log-transform to reduce skewness, then standardise (centre and scale) to have a mean of 0 and a standard deviation of 1, making it easier to compare with other variables.
# Temperature, shade score and litter size: standardise
dt$zLength <- scale(log(dt$Tail_length))
dt$zMass <- scale(log(dt$Mass))
dt$zShade<-scale(dt$shade_score)
dt$zTemp <- scale(dt$Mean_Annual_Temp)
dt$zLitter_size <- scale(dt$Litter_size)
# Visualise zLength distribution
# hist(dt$zLength)
# Also, convert some columns to factors for analysis just in case
dt <- dt %>%
mutate(across(c(White.tips, Black.tips, Tufts, Naked, Fluffy, Contrasting, Noc, Di, Crep, Autotomy), as.factor))
# Keep species with litter-size data (223 species). Note that the variables above were
# standardised using all 300 Sciuromorpha species with body mass data.
dt <- subset(dt, !is.na(Litter_size))
# 2. Read phylogenetic tree
trees <- read.tree(here("data", "potential", "Rodent_tail", "RodentTrees.tre")) # 100 trees
tree <- trees[[1]] # Here we use only one tree
# Trim out everything from the tree that's not in the modified dataset
trees <- lapply(trees, drop.tip,tip=setdiff(tree$tip.label, dt$Phylo))
# Select one tree for trimming purposes
tree <- trees[[1]]
tree <- force.ultrametric(tree, method = c("extend")) # Convert non-ultrametric tree to ultrametric treeHow to model? How to interpret the output?
Let’s start by running the model. The first model we will fit is a simple animal model with no explanatory variables (only an intercept as the fixed effect) and a phylogenetic random effect. From here on, we will always begin with this simplest model to assess the phylogenetic signal of the response variable before adding more complexity by including one continuous and one categorical explanatory variable.
Fitting a model basically involves three or four steps:
Get the phylogenetic relatedness matrix: its inverse for
MCMCglmm(inverseA()) and the phylogenetic correlation matrix forbrms(vcv.phylo(..., corr = TRUE))Set priors for your model and run the model with the default number of iterations, thinning interval and burn-in (warm-up)
Check mixing and convergence, and inspect the posterior distributions of the fixed and random effects
If the chains do not mix well or show signs of non-convergence…
- run longer chains (more iterations after burn-in) and check whether the burn-in (warm-up) is long enough
- reconsider the prior settings and the model specification
Univariate model
Intercept-only model
MCMCglmm
To get the variance-covariance matrix, we use the inverseA() function in MCMCglmm:
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE) # Calculate the inverse of the phylogenetic relatedness matrix for all nodes, scaling the resultsThen, we will define the priors for the phylogenetic effect and the residual variance using the following code:
prior1 <- list(R = list(V = 1, nu = 0.002), # Prior for residuals: weak inverse-Wishart prior for residual variance
G = list(G1 = list(V = 1, nu = 0.002))) # Prior for random effect: weak inverse-Wishart for random effectWe set inverse-Wishart priors with V = 1 and nu = 0.002 for both the residual variance and the phylogenetic variance. For a single variance, this corresponds to an inverse-gamma prior with shape and scale of 0.001, which is commonly used as a weakly informative prior. It is not “uninformative” in every situation: when the data contain little information about a variance component, especially when the variance is close to zero, this prior can still influence the posterior. We therefore recommend checking how sensitive your results are to the prior (e.g. by refitting the model with a parameter-expanded prior, as we do for the discrete models below). If you have prior knowledge about your study system, you can also use a more informative prior.
In MCMCglmm, the prior list can contain four elements: R (R-structure, residual variances), G (G-structure, random-effect variances), B (fixed effects), and S (the theta_scale parameter). Here, we explain B, R and G.
| Parameter | Which elements | Meaning | Effect of increasing the value | Effect of decreasing the value |
|---|---|---|---|---|
| V | B | Prior (co)variance matrix of the fixed effects (multivariate normal prior) | Wider prior on the fixed effects; the data have more influence | Narrower prior; estimates are shrunk more strongly towards mu |
| mu | B | Prior mean vector of the fixed effects | Shifts the prior centre upwards | Shifts the prior centre downwards |
| V | R, G | Scale matrix of the inverse-Wishart prior on a (co)variance matrix. Together with nu, it determines where the prior places its mass (for a single variance, the prior is inverse-gamma with shape nu/2 and scale nu*V/2) |
Places more prior mass on larger variances | Places more prior mass on smaller variances |
| nu | R, G | Degree-of-belief parameter of the inverse-Wishart prior | The prior becomes more concentrated (more informative) | The prior becomes more diffuse (less informative); nu = 0.002 is often used for a single variance |
| fix | R, G | If fix = 1, the (co)variance matrix (from the fix-th dimension onwards) is fixed at V and not estimated (e.g. the residual variance of binary models) |
NA | NA |
| alpha.mu | G (and R) | Prior mean of the redundant working parameters used for parameter expansion. With alpha.mu/alpha.V specified, the prior on the variance is a scaled non-central F-distribution (for a single variance with V = 1, nu = 1, alpha.mu = 0, the prior on the standard deviation is half-Cauchy with scale sqrt(alpha.V)) |
Changes the location of the implied prior on the variance | Changes the location of the implied prior on the variance |
| alpha.V | G (and R) | Prior (co)variance of the working parameters; it acts as the scale of the implied prior on the variance | Heavier upper tail; larger variances receive more prior support | Implied prior concentrates on smaller variances |
Note that the G element contains one prior for each random-effect term (G1, G2, G3…). For example, if you have three random-effect terms, you need to define three priors in G.
In MCMCglmm, the variance components are divided into two structures: G (here, the phylogenetic variance) and R (the residual, non-phylogenetic variance). From these, we can calculate the phylogenetic heritability (the proportion of the variance on the modelled scale that is attributed to the phylogenetic random effect) using the following equation:
\[ H^2 = \frac{\sigma_{a}^2}{\sigma_{a}^2 + \sigma_{e}^2} \]
Throughout this tutorial, we call this proportion the “phylogenetic signal” for brevity. It is a variance-partitioning measure (a phylogenetic intraclass correlation, or phylogenetic heritability) on the scale of the model, i.e. on the latent scale for discrete responses. It is not Pagel’s \(\lambda\), although the two are closely related for Gaussian data. We calculate it for every posterior draw and then summarise the resulting posterior distribution.
When we do not include any explanatory variables (intercept-only model), we use ~ 1. We use larger values of nitt, thin and burnin than the defaults (nitt = 13000, thin = 10, burnin = 3000). The longer chain after burn-in gives more posterior samples and therefore more precise Monte Carlo estimates, and the larger thinning interval reduces autocorrelation among the stored samples and the storage required; neither of these guarantees convergence, which still needs to be checked.
# You can check model running time by system.time() function. Knowing the running time is important when you trial and error to find the best model setting!
system.time(
mcmcglmm_mg1 <- run_mcmcglmm_chains(zLength ~ 1, # Response variable zLength with an intercept-only model
random = ~ Phylo, # Random effect for Phylo
ginverse = list(Phylo = inv_phylo$Ainv), # Specifies the inverse phylogenetic covariance matrix Ainv for Phylo, which accounts for phylogenetic relationships.
prior = prior1, # Prior distributions for the model parameters
family = "gaussian", # Family of the response variable (Gaussian for continuous data)
data = dt, # Dataset used for fitting the model
seeds = c(20263026, 20263027, 20263028, 20263029), # one seed per chain (four chains)
nitt = 13000*20, # Total number of iterations (20 times the default)
thin = 10*20, # Thinning interval (20 times the default)
burnin = 3000*20 # Number of burn-in iterations (20 times the default)
)
)
summarise_chains(mcmcglmm_mg1)To begin with, we should check mixing and convergence. We can assess them using trace plots, autocorrelation plots and the effective sample size. A trace plot that looks like a “fuzzy caterpillar” (no trends and no long excursions) is evidence of good mixing and stationarity, but it is not proof of convergence; running several independent chains and comparing them (e.g. with R-hat) gives stronger evidence.
plot(chains_list(mcmcglmm_mg1, "VCV")) # Visualise variance component 
plot(chains_list(mcmcglmm_mg1, "Sol")) # Visualise location effects
autocorr.plot(chains_list(mcmcglmm_mg1, "VCV")) # Check chain mixing
autocorr.plot(chains_list(mcmcglmm_mg1, "Sol")) # Check chain mixing
summarise_chains(mcmcglmm_mg1) # pooled posterior summaries and between-chain diagnostics
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.18450 0.61460 -1.41800 1.01700 1 3984 4000
#> 2 Phylo 1.50000 0.22080 1.11100 1.98400 1 3833 3835
#> 3 units 0.02811 0.01025 0.01077 0.05096 1 3639 3892The four chains agree with each other: all R-hat values are below 1.01 and the bulk and tail effective sample sizes are above 3,600. Throughout this tutorial, we report the posterior mean and the 95% equal-tailed credible interval (the Q2.5 and Q97.5 columns) calculated from the pooled draws of the four chains. The phylogenetic variance (Phylo) is 1.50 (95% CI 1.11, 1.98), which is much larger than the residual variance (units, 0.028 [0.011, 0.051]). The intercept is −0.18 (−1.42, 1.02).
brms
The formula syntax is similar to that of the lme4 package (lmer()). One of the advantages of brms is that it can fit complex models with multiple random effects and non-linear terms. The model fitting process is similar to MCMCglmm but with a different syntax. The output also differs between the two packages.
In brms, we can use the default_prior() function (formerly get_prior()) to see the priors that brms would use for the model. Note that the defaults are not all weakly informative: population-level effects (class = "b") get flat (improper) priors by default, whereas intercepts and standard deviations get weakly informative Student-t priors scaled to the data (see ?set_prior and the brms documentation). In this tutorial we pass these default priors explicitly via prior = ..., which is equivalent to not specifying them. You can also set your own priors if you know your study system well (see Section 4).
In brms, the phylogeny enters the model through gr(Phylo, cov = A), where A is a matrix proportional to the covariance matrix of the phylogenetic effects. The official brms phylogenetic vignette uses vcv.phylo(tree), i.e. the phylogenetic variance-covariance matrix, and that is valid. Here we use vcv.phylo(tree, corr = TRUE), which returns the phylogenetic correlation matrix. For an ultrametric tree, this simply rescales the tree to a root-to-tip distance of 1, so the estimated phylogenetic variance is expressed per unit tree height. We do this deliberately so that the scale matches the MCMCglmm models, where inverseA(tree, scale = TRUE) applies the same rescaling. With the unscaled covariance matrix, the phylogenetic standard deviation would be rescaled by the square root of the tree height, but the fitted model would otherwise be the same.
We use larger values of iter and warmup than the defaults (iter = 2000, warmup = 1000) to obtain more post-warm-up draws and hence larger effective sample sizes. We also set the control argument control = list(adapt_delta = 0.99, max_treedepth = 15) to reduce the risk of divergent transitions. Setting adapt_delta closer to 1 generally leads Stan to use a smaller step size, which can help reduce divergent transitions, and a larger max_treedepth allows longer trajectories per iteration.
By default, brms runs four independent Markov chains (chains = 4). Multiple chains are needed to compute between-chain diagnostics such as R-hat, and four chains give more reliable diagnostics than two. All brms models in this tutorial use four chains; cores = 4 runs them in parallel, and seed makes the fit reproducible. The MCMCglmm models also use four independent chains (see Note 4 above).
A <- ape::vcv.phylo(tree, corr = TRUE) # Phylogenetic correlation matrix (tree rescaled to unit height)
default_priors1 <- default_prior(
zLength ~ 1 + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg1 <- brm(zLength ~ 1 + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_priors1,
iter = 10000,
warmup = 5000,
thin = 1,
chains = 4,
cores = 4,
seed = 20266826,
control = list(adapt_delta = 0.99, max_treedepth = 15)
)
)In brms, we can also check the Rhat value, which compares the chains with each other. Values close to 1.00 (we use < 1.01 as a rule of thumb) indicate no evidence of non-convergence; it does not prove convergence.
plot(brms_mg1) # Visualise effects
summary(brms_mg1) # See the result
#> Family: gaussian
#> Links: mu = identity
#> Formula: zLength ~ 1 + (1 | gr(Phylo, cov = A))
#> Data: dt (Number of observations: 223)
#> Draws: 4 chains, each with iter = 10000; warmup = 5000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 223)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.22 0.09 1.05 1.40 1.01 1215 2945
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.13 0.60 -1.30 1.04 1.00 3141 5966
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.17 0.03 0.11 0.23 1.01 757 1143
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).To check the consistency between the results obtained from MCMCglmm and brms, we compare the posterior means of the fixed effects and the random-effect variances. Note that the random-effect and residual estimates are reported on different scales in the two packages. MCMCglmm reports variances (G-structure / R-structure), whereas brms reports standard deviations (Multilevel Hyperparameters / Further Distributional Parameters). To compare them, we square the brms standard deviations. We do this for each posterior draw and then summarise the draws, because the square of the posterior mean of a standard deviation is not the posterior mean of the variance. Derived quantities, such as the proportion of variance attributed to phylogeny, are likewise calculated for every posterior draw before summarising.
As you can see below, the MCMCglmm and brms estimates do not match exactly. However, the values are close and the overall pattern is consistent, so the two approaches lead to the same conclusions. The differences come from factors such as the sampling algorithms and the prior settings of each package.
Before comparing the estimates, we check the sampler diagnostics of the brms fit (for MCMCglmm, which uses a different sampler, these diagnostics do not exist). There are no divergent transitions, and the tree depth stayed below the maximum. However, the E-BFMI (energy Bayesian fraction of missing information) of each chain is low (about 0.12; values below 0.3 are usually flagged). A low E-BFMI means that the sampler explores some parts of the posterior, here mainly the residual standard deviation, inefficiently. Because the four chains agree (R-hat < 1.01) and the effective sample sizes are adequate (bulk ESS of sigma ≈ 760), we still use this fit. The low E-BFMI is a warning, though, that the posterior geometry of this model is difficult; we return to this below, where the same problem causes a sampling failure.
# sampler diagnostics for the Gaussian brms models (four chains each)
sampler_check <- function(fit) {
np <- nuts_params(fit)
c(divergent = sum(np$Value[np$Parameter == "divergent__"]),
max_treedepth_used = max(np$Value[np$Parameter == "treedepth__"]),
min_E_BFMI = round(min(rstan::get_bfmi(fit$fit)), 2))
}
sampler_check(brms_mg1)
#> divergent max_treedepth_used min_E_BFMI
#> 0.00 10.00 0.12 Intercept
posterior_summary(pool_chains(mcmcglmm_mg1, "Sol")) # MCMCglmm (pooled draws of four chains)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.1845167 0.6146319 -1.41773 1.017192
draws_df <- as_draws_df(brms_mg1) # Convert brms object to data frame
posterior_summary(draws_df$b_Intercept) # brms
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] -0.1281425 0.5960931 -1.295102 1.040134Random effect and phylogenetic signals (and also residuals)
VCV <- pool_chains(mcmcglmm_mg1, "VCV")
# phylogenetic variance
posterior_summary(VCV[, "Phylo"]) # MCMCglmm (G-structure)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 1.500394 0.2207623 1.110933 1.983682
posterior_summary(draws_df$sd_Phylo__Intercept^2) # brms (SD squared for each draw)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 1.491179 0.2176515 1.09338 1.946597
# residual variance
posterior_summary(VCV[, "units"]) # MCMCglmm (R-structure)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.02811027 0.0102538 0.01076925 0.05096317
posterior_summary(draws_df$sigma^2) # brms
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.0293677 0.01092228 0.01220014 0.05452798
# phylogenetic heritability (calculated for each draw)
h2_mcmcglmm <- VCV[, "Phylo"] / (VCV[, "Phylo"] + VCV[, "units"])
h2_brms <- with(draws_df, sd_Phylo__Intercept^2 / (sd_Phylo__Intercept^2 + sigma^2))
posterior_summary(h2_mcmcglmm)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.980738 0.008752216 0.9604654 0.994118
posterior_summary(h2_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.9797531 0.009534434 0.9565043 0.9931725The two packages give almost identical results. The phylogenetic variance is 1.50 (1.11, 1.98) in MCMCglmm and 1.49 (1.09, 1.95) in brms, and the residual variance is 0.028 (0.011, 0.051) and 0.029 (0.012, 0.055), respectively. The phylogenetic heritability is 0.98 (0.96, 0.99) in both packages: almost all of the variation in standardised tail length is attributed to phylogeny. Note that this intercept-only model does not account for body size.
One continuous explanatory variable model
MCMCglmm
system.time(
mcmcglmm_mg2 <- run_mcmcglmm_chains(zLength ~ zTemp,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
prior = prior1,
family = "gaussian",
data = dt,
seeds = c(20263126, 20263127, 20263128, 20263129), # one seed per chain (four chains)
nitt = 13000*25,
thin = 10*25,
burnin = 3000*25
)
)summarise_chains(mcmcglmm_mg2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.18190 0.60860 -1.39700 1.00200 1.000 4313 4010
#> 2 zTemp 0.03621 0.04637 -0.05496 0.12720 1.000 4039 3826
#> 3 Phylo 1.46600 0.22910 1.06900 1.96300 1.002 3713 3925
#> 4 units 0.03080 0.01132 0.01217 0.05668 1.000 3831 3886
posterior_summary(pool_chains(mcmcglmm_mg2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.46551508 0.22910115 1.0693894 1.96334803
#> units 0.03079797 0.01131706 0.0121687 0.05668468
posterior_summary(pool_chains(mcmcglmm_mg2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.18190030 0.60860496 -1.39717815 1.0020822
#> zTemp 0.03621378 0.04637304 -0.05495517 0.1271544The posterior mean of the slope of standardised temperature is 0.036, with a 95% credible interval of [−0.055, 0.127]. The interval includes zero, so there is little evidence for a relationship between temperature and tail length in this model. The intercept, the expected (standardised) tail length when standardised temperature is zero, is −0.18 (−1.40, 1.00).
The summary() of a single MCMCglmm fit reports 95% HPD (highest posterior density) intervals, whereas brms reports 95% equal-tailed credible intervals (CI). The two intervals serve a similar purpose, but they are constructed differently and can differ, especially for skewed posterior distributions such as those of variances. In this tutorial, we therefore report 95% equal-tailed intervals for both packages (the Q2.5 and Q97.5 columns of summarise_chains() and posterior_summary()), so that the packages are compared on the same footing.
Highest Posterior Density (HPD) Interval:
The HPD interval is the narrowest interval that contains a specified proportion (e.g., 95%) of the posterior distribution. It includes the most probable values of the parameter, ensuring that every point inside the interval has a higher posterior density than any point outside.
Equal-Tailed Credible Interval (CI):
An equal-tailed credible interval includes the central 95% of the posterior distribution, leaving equal probabilities (2.5%) in each tail. This means that there’s a 2.5% chance that the parameter is below the interval and a 2.5% chance that it’s above.
See, for example, the documentation of HDInterval::hdi() for more details.
brms
default_priors2 <- default_prior(
zLength ~ zTemp + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg2 <- brm(zLength ~ zTemp + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_priors2,
iter = 10000,
warmup = 5000,
thin = 1,
chains = 4,
cores = 4,
seed = 20269226,
control = list(adapt_delta = 0.99, max_treedepth = 15)
)
)summary(brms_mg2)
#> Family: gaussian
#> Links: mu = identity
#> Formula: zLength ~ zTemp + (1 | gr(Phylo, cov = A))
#> Data: dt (Number of observations: 223)
#> Draws: 4 chains, each with iter = 10000; warmup = 5000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 223)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.20 0.09 1.03 1.38 1.00 1360 2782
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.16 0.59 -1.31 1.00 1.00 2935 5247
#> zTemp 0.04 0.05 -0.05 0.13 1.00 4481 8278
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.18 0.03 0.12 0.24 1.01 914 1289
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
sampler_check(brms_mg2)
#> divergent max_treedepth_used min_E_BFMI
#> 0.00 11.00 0.11 The posterior estimate for the effect of zTemp on zLength is 0.04, with a 95% credible interval of [−0.05, 0.13]. The interval includes zero, so there is little evidence for a relationship between standardised temperature and tail length. The intercept is −0.16 (−1.31, 1.00). As for the intercept-only model, there are no divergent transitions, but the E-BFMI is low; the chains agree and the effective sample sizes are adequate.
The results of MCMCglmm and brms are consistent: the slope of zTemp is 0.036 (−0.055, 0.127) and 0.04 (−0.05, 0.13), respectively, and the variance components are also very similar. The small remaining differences come from Monte Carlo error and the different priors, and they do not affect the conclusions.
One continuous and one categorical explanatory variable model
Finally, we add a categorical explanatory variable, Contrasting, to the above model. In this model, we test whether species with contrasting tail tips have longer tails than those without contrasting tail tips, after controlling for the effect of temperature.
MCMCglmm
system.time(
mcmcglmm_mg3 <- run_mcmcglmm_chains(zLength ~ zTemp + Contrasting,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
prior = prior1,
family = "gaussian",
data = dt,
seeds = c(20263226, 20263227, 20263228, 20263229), # one seed per chain (four chains)
nitt=13000*30,
thin=10*30,
burnin=3000*30
)
)summarise_chains(mcmcglmm_mg3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.18680 0.62510 -1.44400 1.04900 1.000 3776 4015
#> 2 zTemp 0.03268 0.04540 -0.05417 0.12370 1.000 3968 3738
#> 3 Contrasting1 0.14530 0.06260 0.02089 0.26430 1.000 3866 3930
#> 4 Phylo 1.54200 0.23330 1.11900 2.04600 1.000 3919 3974
#> 5 units 0.02370 0.01059 0.00623 0.04724 1.001 3948 3774
posterior_summary(pool_chains(mcmcglmm_mg3, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.5422156 0.23329896 1.11915578 2.04637457
#> units 0.0237028 0.01058709 0.00623028 0.04723906
posterior_summary(pool_chains(mcmcglmm_mg3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.18682738 0.62506063 -1.44395589 1.0493791
#> zTemp 0.03267584 0.04540308 -0.05417217 0.1236664
#> Contrasting1 0.14525559 0.06260417 0.02089266 0.2643381After accounting for temperature, species with contrasting tail tips have longer tails than species without them (Contrasting1: 0.145, 95% CI [0.021, 0.264]; the interval excludes zero). The temperature effect remains small and uncertain (0.033 [−0.054, 0.124]).
brms
default_priors3 <- default_prior(
zLength ~ zTemp + Contrasting + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg3 <- brm(zLength ~ zTemp + Contrasting + (1|gr(Phylo, cov = A)),
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_priors3,
iter = 10000,
warmup = 5000,
thin = 1,
chains = 4,
cores = 4,
seed = 20269326,
control = list(adapt_delta = 0.99, max_treedepth = 15)
)
)# sampler diagnostics first: this fit did NOT sample successfully
sampler_check(brms_mg3)
#> divergent max_treedepth_used min_E_BFMI
#> 4931.00 10.00 0.08
# posterior summaries of the key parameters for each chain separately
draws_mg3 <- as_draws_df(brms_mg3)
aggregate(cbind(sigma, sd_Phylo__Intercept, b_Contrasting1) ~ .chain, data = draws_mg3, FUN = median)
#> .chain sigma sd_Phylo__Intercept b_Contrasting1
#> 1 1 0.15780387 1.228627 0.1465252
#> 2 2 0.02097356 1.380296 0.2211975
#> 3 3 0.15121142 1.241000 0.1427636
#> 4 4 0.15256776 1.235058 0.1453377The brms fit of this model is a sampling failure. With four chains, adapt_delta = 0.99 and max_treedepth = 15, one chain became trapped in a region with a very small residual standard deviation (sigma close to 0.02, compared with about 0.15 in the other chains) and produced 4,931 divergent transitions. As a result, R-hat is far above 1.01 (up to 1.2) and the bulk ESS of several parameters is below 10. The other three chains agree with each other, but discarding the failed chain would not make the fit valid, so we do not interpret the brms estimates of this model.
The problem is the posterior geometry of these Gaussian models with one observation per species: the residual standard deviation and the 223 phylogenetic effects are strongly dependent (a “funnel”). This also causes the low E-BFMI values of the brms fits of the two simpler models (see above), although those fits have no divergent transitions and their chains agree. Possible remedies are a different (e.g. centred or marginalised) parameterisation of the phylogenetic effect, which is beyond the scope of this tutorial. For this model, we therefore rely on the MCMCglmm fit, whose four chains converged.
Bivariate model
Here, we provide a more advanced extension: a bivariate model. A bivariate model has a structure similar to the nominal model (several linear predictors with correlated random effects), and it allows us to examine the relationship between two response variables while accounting for explanatory variables. In this model, we will include two response variables, zLength and zMass, and test the relationship between these two variables and the explanatory variables, zTemp and Contrasting. This model can examine the evolutionary correlation between tail length and body mass in rodents, considering the phylogenetic relationships.
In MCMCglmm, we use cbind(traitA, traitB) to set the response variables (this allows us to estimate the covariance between the two response variables). In brms, we use mvbind(traitA, traitB) to set the response variables. The family argument specifies the distribution (and link function) of the response variables; if a single family is given, it is used for both responses. It does not specify the distribution of the random effects, which are always assumed to be (multivariate) normal.
An important point is that MCMCglmm estimates the covariances between the two response variables (with us(trait)), not their correlations, whereas brms reports correlations directly. Two different correlations are involved:
- Phylogenetic (group-level) correlation: in
brms, we write(1|a|gr(Phylo, cov = A))instead of(1|gr(Phylo, cov = A)). The shared IDa(any label can be used) tellsbrmsthat the phylogenetic effects of the two responses are correlated; without it, they are modelled as independent. - Residual correlation:
set_rescor(TRUE)estimates the correlation between the residuals of the two responses. This is a separate quantity and is available only for some families (e.g. Gaussian); it is unrelated to the phylogenetic correlation.
In MCMCglmm, we calculate each correlation from the (co)variance estimates of each posterior draw, by dividing the covariance by the product of the standard deviations of the two traits.
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior2 <- list(G = list(G1 = list(V = diag(2),
nu = 2, alpha.mu = rep(0, 2),
alpha.V = diag(2) * 1000)),
R = list(V = diag(2), nu = 0.002)
)
system.time(
mcmcglmm_mg4 <- run_mcmcglmm_chains(cbind(zLength, zMass) ~ trait - 1,
random = ~ us(trait):Phylo,
rcov = ~ us(trait):units,
family = c("gaussian", "gaussian"),
ginv = list(Phylo = inv_phylo$Ainv),
data = dt,
prior = prior2,
seeds = c(20263326, 20263327, 20263328, 20263329), # one seed per chain (four chains)
nitt = 13000*55,
thin = 10*55,
burnin = 3000*55
)
)
system.time(
mcmcglmm_mg5 <- run_mcmcglmm_chains(cbind(zLength, zMass) ~ zTemp:trait + trait - 1,
random = ~ us(trait):Phylo,
rcov = ~ us(trait):units,
family = c("gaussian", "gaussian"),
ginv = list(Phylo = inv_phylo$Ainv),
data = dt,
prior = prior2,
seeds = 1:4, # extension: results are not shown in this tutorial
nitt = 13000*55,
thin = 10*55,
burnin = 3000*55
)
)
system.time(
mcmcglmm_mg6 <- run_mcmcglmm_chains(cbind(zLength, zMass) ~ zTemp:trait + Contrasting:trait + trait -1,
random = ~ us(trait):Phylo,
rcov = ~ us(trait):units,
family = c("gaussian", "gaussian"),
ginv = list(Phylo = inv_phylo$Ainv),
data = dt,
prior = prior2,
seeds = 1:4, # extension: results are not shown in this tutorial
nitt = 13000*55,
thin = 10*55,
burnin = 3000*55
)
)
## brms
A <- ape::vcv.phylo(tree, corr = TRUE)
formula <- bf(mvbind(zLength, zMass) ~ 1 +
(1|a|gr(Phylo, cov = A)),
set_rescor(rescor = TRUE)
)
default_prior1 <- default_prior(formula,
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg4 <- brm(formula = formula,
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_prior1,
iter = 35000,
warmup = 25000,
thin = 1,
chains = 4,
cores = 4,
seed = 20272226,
control = list(adapt_delta = 0.99)
)
)
formula2 <- bf(mvbind(zLength, zMass) ~ zTemp + (1|a|gr(Phylo, cov = A)), set_rescor(TRUE))
default_prior2 <- default_prior(formula2,
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg5 <- brm(formula = formula2,
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_prior2,
iter = 55000,
warmup = 45000,
thin = 1,
chains = 4,
cores = 4, # extension: results are not shown in this tutorial
control = list(adapt_delta = 0.99)
)
)
formula3 <- bf(mvbind(zLength, zMass) ~ zTemp + Contrasting + (1|a|gr(Phylo, cov = A)), set_rescor(TRUE))
default_prior3 <- default_prior(formula3,
data = dt,
data2 = list(A = A),
family = gaussian()
)
system.time(
brms_mg6 <- brm(formula = formula3,
data = dt,
data2 = list(A = A),
family = gaussian(),
prior = default_prior3,
iter = 35000,
warmup = 10000,
thin = 1,
chains = 4,
cores = 4, # extension: results are not shown in this tutorial
control = list(adapt_delta = 0.99)
)
)summarise_chains(mcmcglmm_mg4)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitzLength -0.169000 0.627700 -1.371000 1.08800 1.000 3478 3800
#> 2 traitzMass -0.441100 0.671500 -1.762000 0.89030 1.001 3961 3935
#> 3 traitzLength:traitzLength.Phylo 1.523000 0.227300 1.135000 2.01200 1.000 3731 4075
#> 4 traitzMass:traitzLength.Phylo -0.098280 0.154900 -0.408500 0.20720 1.000 4062 3702
#> 5 traitzLength:traitzMass.Phylo -0.098280 0.154900 -0.408500 0.20720 1.000 4062 3702
#> 6 traitzMass:traitzMass.Phylo 1.690000 0.241400 1.272000 2.20400 1.000 3918 3971
#> 7 traitzLength:traitzLength.units 0.028000 0.010500 0.010290 0.05145 1.001 4245 4030
#> 8 traitzMass:traitzLength.units 0.006463 0.007942 -0.008468 0.02276 1.000 4189 3691
#> 9 traitzLength:traitzMass.units 0.006463 0.007942 -0.008468 0.02276 1.000 4189 3691
#> 10 traitzMass:traitzMass.units 0.062630 0.014050 0.039370 0.09475 1.000 4037 3999
posterior_summary(pool_chains(mcmcglmm_mg4, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitzLength:traitzLength.Phylo 1.522956574 0.227298775 1.135194847 2.01208051
#> traitzMass:traitzLength.Phylo -0.098275892 0.154877997 -0.408486575 0.20723699
#> traitzLength:traitzMass.Phylo -0.098275892 0.154877997 -0.408486575 0.20723699
#> traitzMass:traitzMass.Phylo 1.690069097 0.241438904 1.271843051 2.20377962
#> traitzLength:traitzLength.units 0.028002415 0.010501743 0.010288271 0.05144526
#> traitzMass:traitzLength.units 0.006462884 0.007941619 -0.008467541 0.02275695
#> traitzLength:traitzMass.units 0.006462884 0.007941619 -0.008467541 0.02275695
#> traitzMass:traitzMass.units 0.062626562 0.014051796 0.039370515 0.09475061
posterior_summary(pool_chains(mcmcglmm_mg4, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitzLength -0.1689755 0.6276594 -1.371252 1.0877905
#> traitzMass -0.4411276 0.6714691 -1.762460 0.8903338
# Phylogenetic and residual (non-phylogenetic) correlations between zLength and zMass,
# calculated for each posterior draw: covariance / (SD1 * SD2)
VCV <- pool_chains(mcmcglmm_mg4, "VCV")
corr_p <- VCV[, "traitzMass:traitzLength.Phylo"] /
sqrt(VCV[, "traitzLength:traitzLength.Phylo"] * VCV[, "traitzMass:traitzMass.Phylo"])
corr_nonp <- VCV[, "traitzMass:traitzLength.units"] /
sqrt(VCV[, "traitzLength:traitzLength.units"] * VCV[, "traitzMass:traitzMass.units"])
posterior_summary(corr_p)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.06237168 0.0963816 -0.2500739 0.1273954
posterior_summary(corr_nonp)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.1554446 0.185267 -0.2161848 0.4952001
summary(brms_mg4)
#> Family: MV(gaussian, gaussian)
#> Links: mu = identity
#> mu = identity
#> Formula: zLength ~ 1 + (1 | a | gr(Phylo, cov = A))
#> zMass ~ 1 + (1 | a | gr(Phylo, cov = A))
#> Data: dt (Number of observations: 223)
#> Draws: 4 chains, each with iter = 35000; warmup = 25000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 223)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(zLength_Intercept) 1.21 0.09 1.04 1.39 1.00 2813 7426
#> sd(zMass_Intercept) 1.29 0.09 1.12 1.48 1.00 7806 16716
#> cor(zLength_Intercept,zMass_Intercept) -0.06 0.10 -0.26 0.13 1.00 5211 10724
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> zLength_Intercept -0.14 0.60 -1.31 1.04 1.00 8144 14872
#> zMass_Intercept -0.42 0.63 -1.66 0.81 1.00 10395 16326
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma_zLength 0.17 0.03 0.11 0.24 1.00 1851 3159
#> sigma_zMass 0.25 0.03 0.20 0.31 1.00 5465 12265
#>
#> Residual Correlations:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> rescor(zLength,zMass) 0.15 0.18 -0.21 0.48 1.00 4216 8216
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The two packages give consistent results. The phylogenetic correlation between tail length and body mass is close to zero, with 95% credible intervals that include zero: −0.06 (95% CI −0.25, 0.13) in MCMCglmm and −0.06 (−0.26, 0.13) in brms. The residual (non-phylogenetic) correlation is also uncertain: 0.16 (−0.22, 0.50) and 0.15 (−0.21, 0.48), respectively. As in the univariate models, the brms fit has no divergent transitions but a low E-BFMI (0.17), and its four chains agree (R-hat < 1.01).
Below, we compare the variance components and the phylogenetic heritabilities of the two traits. Each quantity is calculated for every posterior draw (for brms, by squaring the standard deviations draw by draw) before summarising.
draws_df <- as_draws_df(brms_mg4) # Convert brms object to data frame
VCV <- pool_chains(mcmcglmm_mg4, "VCV")
# phylogenetic variance - length
posterior_summary(VCV[, "traitzLength:traitzLength.Phylo"]) # MCMCglmm (G-structure)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 1.522957 0.2272988 1.135195 2.012081
posterior_summary(draws_df$sd_Phylo__zLength_Intercept^2) # brms (SD squared for each draw)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 1.478843 0.2174682 1.089848 1.94505
# phylogenetic variance - mass
posterior_summary(VCV[, "traitzMass:traitzMass.Phylo"])
#> Estimate Est.Error Q2.5 Q97.5
#> var1 1.690069 0.2414389 1.271843 2.20378
posterior_summary(draws_df$sd_Phylo__zMass_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 1.673684 0.2353912 1.258035 2.179566
# residual variance - length
posterior_summary(VCV[, "traitzLength:traitzLength.units"]) # MCMCglmm (R-structure)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.02800242 0.01050174 0.01028827 0.05144526
posterior_summary(draws_df$sigma_zLength^2) # brms
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.03088028 0.01090177 0.01288607 0.05529436
# residual variance - mass
posterior_summary(VCV[, "traitzMass:traitzMass.units"])
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.06262656 0.0140518 0.03937052 0.09475061
posterior_summary(draws_df$sigma_zMass^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.06410401 0.01452617 0.03986941 0.09650143
# phylogenetic heritability - length (calculated for each draw)
h2_length_mcmcglmm <- VCV[, "traitzLength:traitzLength.Phylo"] /
(VCV[, "traitzLength:traitzLength.Phylo"] + VCV[, "traitzLength:traitzLength.units"])
h2_length_brms <- with(draws_df, sd_Phylo__zLength_Intercept^2 /
(sd_Phylo__zLength_Intercept^2 + sigma_zLength^2))
posterior_summary(h2_length_mcmcglmm)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.9810507 0.0088351 0.9608274 0.9945062
posterior_summary(h2_length_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.9786051 0.009547454 0.9559388 0.9927668
# phylogenetic heritability - mass
h2_mass_mcmcglmm <- VCV[, "traitzMass:traitzMass.Phylo"] /
(VCV[, "traitzMass:traitzMass.Phylo"] + VCV[, "traitzMass:traitzMass.units"])
h2_mass_brms <- with(draws_df, sd_Phylo__zMass_Intercept^2 /
(sd_Phylo__zMass_Intercept^2 + sigma_zMass^2))
posterior_summary(h2_mass_mcmcglmm)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.9632801 0.01096532 0.9385308 0.9803033
posterior_summary(h2_mass_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.962113 0.01134253 0.9356861 0.9797784The phylogenetic variances are 1.52 (95% CI 1.14, 2.01) for tail length and 1.69 (1.27, 2.20) for body mass in MCMCglmm, and 1.48 (1.09, 1.95) and 1.67 (1.26, 2.18) in brms. Both traits have very high phylogenetic heritabilities: 0.98 (0.96, 0.99) and 0.96 (0.94, 0.98) for tail length and body mass in both packages. On the modelled scale, almost all of the variation in both traits (after standardisation) is attributed to the phylogenetic random effect, i.e. closely related species have similar tail lengths and body masses.
2. Binary models
Binary models are used when the response variable is binary (0 or 1), such as presence (1) vs. absence (0), survival (1) vs. death (0), success (1) vs. failure (0), or female vs. male. The model describes the probability of the event coded as 1 (the “success”) given the predictor variables. Which category is treated as the event depends on how the response is coded: for a factor, the first level is the reference (failure) and the second level is the event, and by default factor levels are sorted alphabetically. It is therefore good practice to code the response explicitly (e.g. 0 = absent, 1 = present) or set the factor levels yourself.
Explanation of dataset
We tested the relationships between the presence of red–orange pelage on limbs (response variable) and average social group size and activity cycle in primates (265 species). We used the dataset and tree from Macdonald et al. (2024). The dataset contains information on skin and pelage coloration, average social group size, the presence or absence of multilevel hierarchical societies, the colour visual system, and the activity cycle. We aim to test whether the presence of red–orange pelage on limbs is associated with social group size and activity cycle in primates.
To run the model, we need to prepare the data in a suitable format.
p_trees <- read.nexus(here("data", "potential", "primate", "trees100m.nex"))
primate_data <- read.csv(here("data", "potential", "primate", "Primate_data_male.csv"))
p_dat <- primate_data
p_dat <- subset(p_dat, !is.na(vs_male)) # omit NAs by VS predictor
p_dat <- subset(p_dat, !is.na(vs_female))
p_dat <- subset(p_dat, !is.na(activity_cycle)) # omit NAs by activity cycle
p_dat <- subset(p_dat, !is.na(redpeachpink_facial_skin)) # omit NAs in facial skin colour
p_dat <- subset(p_dat, !is.na(social_group_size)) # omit NAs in social group size
p_dat <- subset(p_dat, !is.na(multilevel)) # omit NAs in multilevel society
# Rename the column 'social_group_size' to 'cSocial_group_size' - all continuous variables were centred and standardized by authors
p_dat <- p_dat %>% rename(cSocial_group_size = social_group_size)
p_dat <- p_dat %>%
mutate(across(c(vs_female, vs_male, redpeachpink_facial_skin,red_genitals,red_pelage_head, red_pelage_body_limbs, red_pelage_tail), as.factor))
p_tree <- p_trees[[1]]
p_trees <- lapply(p_trees, drop.tip,tip = setdiff(p_tree$tip.label, p_dat$PhyloName)) #trim out everything from the tree that's not in the dataset
p_tree <- p_trees[[1]] # select one tree for trimming purposes
p_tree <- force.ultrametric(p_tree) # force tree to be ultrametric - all tips equidistant from rootHow to implement models and interpret the outputs?
In MCMCglmm, the binary model can take two kinds of link functions: logit and probit link functions. The logit link function (family = "categorical") is the default in MCMCglmm for the binary model, while the probit link function can be defined using family = "threshold" or family = "ordinal". We recommend using family = "threshold", because it corresponds directly to the standard probit (threshold) model with a residual variance of 1, which has a natural interpretation as an underlying continuous liability, and it often mixes better. Here, we show both models.
Univariate model
Intercept-only model
Probit model
MCMCglmm
We need to set a different prior for binary models from the Gaussian model. Binary models still have unexplained variation, but the observation-level (residual) variance on the latent scale cannot be estimated from 0/1 data: it is not identifiable separately from the scale of the other parameters. It is therefore fixed by convention, and we only set priors for the random effects. In MCMCglmm, we fix the residual (units) variance at 1 with R = list(V = 1, fix = 1), for both the probit (threshold) and the logit (categorical) model. On the latent scale, the distribution-specific variance is 1 for the probit link and \(\pi^2/3\) for the logit link; we use these values when calculating variance proportions below.
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1), # fix residual variance = 1
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BP1 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ 1,
random = ~ PhyloName,
family = "threshold",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263426, 20263427, 20263428, 20263429), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20)
)summarise_chains(mcmcglmm_BP1) # pooled draws of four chains; 95% equal-tailed intervals
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.8754 0.9221 -2.9640 0.8567 1.001 3782 3772
#> 2 PhyloName 3.1730 2.0310 0.6637 8.1880 1.001 3733 4101
#> 3 units 1.0000 0.0000 1.0000 1.0000 NA NA NA
posterior_summary(pool_chains(mcmcglmm_BP1, "VCV")) # 95% CI
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 3.173375 2.031145 0.663664 8.188148
#> units 1.000000 0.000000 1.000000 1.000000
posterior_summary(pool_chains(mcmcglmm_BP1, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.87537 0.9221209 -2.963645 0.8567179As you can see here, the residual variance is fixed at 1: the model did not estimate the residual variance (R-structure). The four chains mix well and agree with each other (R-hat < 1.01). The posterior mean of the phylogenetic variance is 3.17 (95% CI 0.66, 8.19) on the latent (probit) scale, which suggests that the presence of red pelage on the limbs is similar among closely related species. Note that a variance cannot be negative, so its credible interval can never include zero exactly; that the lower limit is away from zero is therefore weaker evidence than for a fixed effect. We assess how much of the variation is attributed to phylogeny with the variance proportion below.
brms
The family argument is set to bernoulli() (not binomial()). The bernoulli() family is used for binary (0/1) data, while the binomial() family is used for the number of successes out of a known number of trials (e.g. N_success | trials(N_trials)).
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms <- default_prior(red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"))
system.time(
brms_BP1 <- brm(red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = priors_brms,
iter = 6000,
warmup = 5000,
thin = 1,
chains = 4,
cores = 4,
seed = 20271026,
control = list(adapt_delta = 0.95)
)
)summary(brms_BP1)
#> Family: bernoulli
#> Links: mu = probit
#> Formula: red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 6000; warmup = 5000; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.68 0.52 0.80 2.88 1.01 992 1772
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.77 0.82 -2.53 0.85 1.00 2458 2581
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).brms gave similar results. Note that the phylogenetic random effect in brms is reported as a standard deviation (sd), so to compare it with MCMCglmm we need to square it (draw by draw). The intercepts were similar in brms and MCMCglmm. brms summaries report 95% equal-tailed credible intervals.
Phylogenetic signals (probit model)
# MCMCglmm: the residual (units) variance is fixed at 1,
# which is the latent-scale residual variance of the probit (threshold) model
h2_mcmcglmm_BP <- pool_chains(mcmcglmm_BP1, "VCV")[, "PhyloName"] / (pool_chains(mcmcglmm_BP1, "VCV")[, "PhyloName"] + 1)
posterior_summary(h2_mcmcglmm_BP)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.7084735 0.1290554 0.398917 0.8911641
# brms: probit latent-scale residual variance = 1 (SD squared for each draw)
h2_brms_BP <- as_draws_df(brms_BP1) %>%
mutate(h2 = sd_PhyloName__Intercept^2 / (sd_PhyloName__Intercept^2 + 1)) %>%
pull(h2)
posterior_summary(h2_brms_BP)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.704689 0.1284413 0.3900843 0.8926042The proportion of the latent-scale variance attributed to the phylogenetic random effect is 0.71 (95% CI 0.40, 0.89) in MCMCglmm and 0.70 (0.39, 0.89) in brms. The difference from the Gaussian model is that the residual variance is not estimated: for the probit link, the latent-scale residual variance is 1. The same applies to the other probit (threshold) models in this tutorial.
Logit model
MCMCglmm
c2 correction
In the logit model, MCMCglmm always includes an additive overdispersion (residual, units) term on the latent scale, here fixed at 1. The estimates are therefore on a different scale from a standard logistic regression without this term, such as the one fitted by brms: the location effects and variance components are inflated (see also Nakagawa & Schielzeth 2010). To make them comparable, we rescale the location effects and the variance components with the constant \(c^2 = (16\sqrt{3}/(15\pi))^2\), which approximately integrates out the residual term (see the MCMCglmm course notes by Jarrod Hadfield). We use the code below:
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- model$Sol / sqrt(1+c2) # for fixed effects
res_2 <- model$VCV / (1+c2) # for variance componentsIn MCMCglmm, the logit model usually mixes more slowly than the probit model, so we use larger values of nitt, thin and burnin than for the probit model to obtain enough effective samples.
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BL1 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ 1,
random = ~ PhyloName,
family = "categorical",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263526, 20263527, 20263528, 20263529), # one seed per chain (four chains)
nitt = 13000*60,
thin = 10*60,
burnin = 3000*60)
)brms
In brms, we do not apply the c2 correction. The brms Bernoulli-logit model has no additive overdispersion term, so its estimates are already on the scale of a standard logistic regression; the MCMCglmm-specific c2 transformation does not apply to it.
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms2 <- default_prior(red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"))
system.time(
brms_BL1 <- brm(red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors_brms2,
iter = 7500,
warmup = 6500,
thin = 1,
chains = 4,
cores = 4,
seed = 20271126,
control = list(adapt_delta = 0.95),
)
)# MCMCglmm
summarise_chains(mcmcglmm_BL1)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -1.671 1.802 -5.640 1.718 1.001 3936 3778
#> 2 PhyloName 11.320 7.403 2.033 30.350 1.000 3755 3728
#> 3 units 1.000 0.000 1.000 1.000 NA NA NA
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmcglmm_BL1, "Sol") / sqrt(1 + c2) # c2-corrected fixed effects
res_2 <- pool_chains(mcmcglmm_BL1, "VCV") / (1 + c2) # c2-corrected variance components
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -1.440472 1.553058 -4.861265 1.480952
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 8.4083590 5.50044 1.5102077 22.5484656
#> units 0.7430287 0.00000 0.7430287 0.7430287
# brms
summary(brms_BL1)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: red_pelage_body_limbs ~ 1 + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 7500; warmup = 6500; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 2.56 0.82 1.13 4.34 1.01 976 1645
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -1.00 1.16 -3.47 1.20 1.00 2546 2282
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).After the c2 correction, the point estimates and 95% CIs of the fixed and random effects are similar between the two packages.
Phylogenetic signals (logit model)
Then, we can obtain the proportion of the latent-scale variance attributed to phylogeny using the conventional distribution-specific variance of the logit link, \(\pi^2/3\):
\[ H^2 = \frac{\sigma_{a}^2}{\sigma_{a}^2 + \pi^2/3} \]
For MCMCglmm, we first apply the c2 correction to the phylogenetic variance, which puts it on the scale of a standard logistic model without the additive overdispersion (units) term, i.e. the same scale as brms. We then use the same definition.
# MCMCglmm: c2-corrected phylogenetic variance
var_phylo_BL <- pool_chains(mcmcglmm_BL1, "VCV")[, "PhyloName"] / (1 + c2)
h2_mcmcglmm_BL <- var_phylo_BL / (var_phylo_BL + pi^2 / 3)
posterior_summary(h2_mcmcglmm_BL)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.661523 0.1441775 0.3146215 0.8726749
# brms
h2_brms_BL <- as_draws_df(brms_BL1) %>%
mutate(h2 = sd_PhyloName__Intercept^2 / (sd_PhyloName__Intercept^2 + pi^2 / 3)) %>%
pull(h2)
posterior_summary(h2_brms_BL)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.6306616 0.1484916 0.279862 0.8515329The two estimates are similar: 0.66 (95% CI 0.31, 0.87) in MCMCglmm and 0.63 (0.28, 0.85) in brms. They are also close to the estimates from the probit model (0.71 and 0.70), as expected, because the variance proportion is defined on the latent scale of each link function.
One continuous explanatory variable model
For the next step, we examine whether group size affects the presence or absence of red pelage on the body/limbs in primates to test the possibility that red pelage is related to social roles and behaviours within the group.
Probit model
The model using MCMCglmm is
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BP2 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ cSocial_group_size,
random = ~ PhyloName,
family = "threshold",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263626, 20263627, 20263628, 20263629), # one seed per chain (four chains)
nitt = 13000*30,
thin = 10*30,
burnin = 3000*30)
)For brms…
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms3 <- default_prior(red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"))
system.time(
brms_BP2 <- brm(red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = priors_brms3,
iter = 10000,
warmup = 8500,
thin = 1,
chains = 4,
cores = 4,
seed = 20271226,
control = list(adapt_delta = 0.95)
)
)# MCMCglmm
summarise_chains(mcmcglmm_BP2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.9072 0.9514 -2.9660 0.7824 1 3987 3773
#> 2 cSocial_group_size -0.1087 0.1342 -0.4051 0.1209 1 3704 3686
#> 3 PhyloName 3.2910 2.2100 0.6581 8.9400 1 3790 3500
#> 4 units 1.0000 0.0000 1.0000 1.0000 NA NA NA
posterior_summary(pool_chains(mcmcglmm_BP2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.9072480 0.9514194 -2.966058 0.7824094
#> cSocial_group_size -0.1086576 0.1342213 -0.405128 0.1208716
# Estimate Est.Error Q2.5 Q97.5
posterior_summary(pool_chains(mcmcglmm_BP2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 3.291433 2.210177 0.6580979 8.940137
#> units 1.000000 0.000000 1.0000000 1.000000
#brms
summary(brms_BP2)
#> Family: bernoulli
#> Links: mu = probit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 10000; warmup = 8500; thin = 1;
#> total post-warmup draws = 6000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.69 0.54 0.79 2.92 1.00 1350 2296
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.81 0.84 -2.66 0.76 1.00 2410 2342
#> cSocial_group_size -0.11 0.13 -0.39 0.12 1.00 6308 4171
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Neither model provides evidence that social group size is associated with the presence of red pelage on the body/limbs in primates: in both packages, the 95% credible intervals of the slope include zero (MCMCglmm: −0.11, 95% CI −0.41, 0.12; brms: −0.11, −0.39, 0.12).
Logit model
The model for MCMCglmm…
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BL2 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ cSocial_group_size,
random = ~ PhyloName,
family = "categorical",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263726, 20263727, 20263728, 20263729), # one seed per chain (four chains)
nitt = 13000*60,
thin = 10*60,
burnin = 3000*60)
)For brms…
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms4 <- default_prior(red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"))
system.time(
brms_BL2 <- brm(red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors_brms4,
iter = 18000,
warmup = 8000,
thin = 1,
chains = 4,
cores = 4,
seed = 20271326,
control = list(adapt_delta = 0.95)
)
)summarise_chains(mcmcglmm_BL2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -1.7570 1.8290 -5.746 1.5180 1.002 3496 3596
#> 2 cSocial_group_size -0.2368 0.2793 -0.867 0.2286 1.000 3850 3894
#> 3 PhyloName 11.8200 8.0720 2.191 32.8700 1.000 3722 3816
#> 4 units 1.0000 0.0000 1.000 1.0000 NA NA NA
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmcglmm_BL2, "Sol") / sqrt(1 + c2)
res_2 <- pool_chains(mcmcglmm_BL2, "VCV") / (1 + c2)
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -1.5148667 1.5765837 -4.9529623 1.3084470
#> cSocial_group_size -0.2041211 0.2407207 -0.7473157 0.1970581
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 8.7802554 5.997474 1.6279013 24.4250920
#> units 0.7430287 0.000000 0.7430287 0.7430287
# brms
summary(brms_BL2)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 2.66 0.86 1.18 4.59 1.00 7816 12510
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -1.09 1.24 -3.67 1.27 1.00 23855 24601
#> cSocial_group_size -0.22 0.25 -0.78 0.19 1.00 52898 28030
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).After the c2 correction, the estimates from the two packages were similar (slope of social group size: −0.20, 95% CI −0.75, 0.20 in MCMCglmm and −0.22, −0.78, 0.19 in brms), and the logit model led to the same conclusion as the probit model: the 95% credible intervals of the slope include zero, so there is no evidence that social group size is associated with red pelage on the body/limbs.
One continuous and one categorical explanatory variable model
Next, we hypothesised that the presence of red pelage might be related to the activity cycle of a species, and we added the activity cycle as a categorical predictor with three levels: cathemeral (cath, the reference level), diurnal (di) and nocturnal (noct). Red colouration may not be as visible in the dark, making it potentially less advantageous for nocturnal species. On the other hand, diurnal species may benefit more from the visibility of red pelage, which could play a role in social/sexual signalling or other ecological functions during the day. The coefficients activity_cycledi and activity_cyclenoct compare diurnal and nocturnal species, respectively, with cathemeral species.
Probit model
The MCMCglmm model is as follows:
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BP3 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle,
random = ~ PhyloName,
family = "threshold",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263826, 20263827, 20263828, 20263829), # one seed per chain (four chains)
nitt = 13000*50,
thin = 10*50,
burnin = 3000*50)
)For brms,
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms5 <- default_prior(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"))
system.time(
brms_BP3 <- brm(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = priors_brms5,
iter = 18000,
warmup = 8000,
thin = 1,
chains = 4,
cores = 4,
seed = 20271426,
control = list(adapt_delta = 0.95)
)
)# MCMCglmm
summarise_chains(mcmcglmm_BP3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -0.75240 1.3720 -3.5530 1.9790 1.000 4012 4000
#> 2 cSocial_group_size -0.11040 0.1401 -0.4077 0.1315 1.000 3906 3753
#> 3 activity_cycledi -0.56440 0.9665 -2.6270 1.2360 1.001 4153 4026
#> 4 activity_cyclenoct -0.01321 0.9999 -2.0650 1.8640 1.000 3932 3801
#> 5 PhyloName 4.27100 3.2390 0.8638 11.5500 1.000 3654 3763
#> 6 units 1.00000 0.0000 1.0000 1.0000 NA NA NA
posterior_summary(pool_chains(mcmcglmm_BP3, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 4.270996 3.238801 0.863752 11.551
#> units 1.000000 0.000000 1.000000 1.000
posterior_summary(pool_chains(mcmcglmm_BP3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -0.75241514 1.3719111 -3.552856 1.9786102
#> cSocial_group_size -0.11043587 0.1401454 -0.407711 0.1315496
#> activity_cycledi -0.56442502 0.9664803 -2.626842 1.2360335
#> activity_cyclenoct -0.01321463 0.9999195 -2.065144 1.8640638
# brms
summary(brms_BP3)
#> Family: bernoulli
#> Links: mu = probit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.86 0.59 0.89 3.20 1.00 7521 13607
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.54 1.23 -3.00 1.91 1.00 15134 20513
#> cSocial_group_size -0.11 0.14 -0.40 0.13 1.00 36416 24459
#> activity_cycledi -0.51 0.92 -2.45 1.22 1.00 17688 19607
#> activity_cyclenoct -0.02 0.95 -1.97 1.79 1.00 18086 19939
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# phylogenetic variance on the same scale (brms SD squared for each draw)
posterior_summary(pool_chains(mcmcglmm_BP3, "VCV")[, "PhyloName"])
#> Estimate Est.Error Q2.5 Q97.5
#> var1 4.270996 3.238801 0.863752 11.551
posterior_summary(as_draws_df(brms_BP3)$sd_PhyloName__Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 3.82254 2.54472 0.784099 10.24598According to the diagnostics we examined, there are no obvious problems with either model: the four MCMCglmm chains agree (R-hat < 1.01, bulk and tail ESS > 3,600 for 4,000 pooled draws), and the brms Rhat values are 1.00 with large bulk and tail ESS.
The phylogenetic variance is similar in the two packages (posterior mean 4.27, 95% CI 0.86, 11.55 in MCMCglmm; 3.82, 0.78, 10.25 in brms, where the SD was squared for each draw), so there is still substantial phylogenetic variation in the presence of red pelage, although with considerable uncertainty.
For the fixed effects, neither social group size (MCMCglmm: −0.11, brms: −0.11) nor activity cycle (diurnal vs cathemeral: −0.56 and −0.51; nocturnal vs cathemeral: −0.01 and −0.02) showed clear effects: all 95% CIs include zero. There is therefore no evidence that group size or activity cycle is associated with the presence of red pelage on the body/limbs.
Logit model
Finally, the logit model. For MCMCglmm:
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mcmcglmm_BL3 <- run_mcmcglmm_chains(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle,
random = ~ PhyloName,
family = "categorical",
data = p_dat,
prior = prior1,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20263926, 20263927, 20263928, 20263929), # one seed per chain (four chains)
nitt = 13000*80,
thin = 10*80,
burnin = 3000*80)
)And brms,
A <- ape::vcv.phylo(p_tree, corr = TRUE)
priors_brms6 <- default_prior(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"))
system.time(
brms_BL3 <- brm(red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A)),
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors_brms6,
iter = 18000,
warmup = 8000,
thin = 1,
chains = 4,
cores = 4,
seed = 20271526,
control = list(adapt_delta = 0.95)
)
)summarise_chains(mcmcglmm_BL3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -1.36400 2.5590 -6.6460 3.3520 1.000 3742 3700
#> 2 cSocial_group_size -0.24360 0.2927 -0.8906 0.2399 1.000 3936 3689
#> 3 activity_cycledi -1.07600 1.8910 -5.0010 2.4090 1.001 3804 3988
#> 4 activity_cyclenoct -0.02888 1.9110 -3.9850 3.7470 1.003 3786 3759
#> 5 PhyloName 15.09000 11.0400 2.8460 42.5300 1.001 3786 3285
#> 6 units 1.00000 0.0000 1.0000 1.0000 NA NA NA
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmcglmm_BL3, "Sol") / sqrt(1 + c2)
res_2 <- pool_chains(mcmcglmm_BL3, "VCV") / (1 + c2)
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -1.17583413 2.2062217 -5.7288183 2.8895852
#> cSocial_group_size -0.21000988 0.2523115 -0.7676931 0.2067998
#> activity_cycledi -0.92784238 1.6304116 -4.3105068 2.0763444
#> activity_cyclenoct -0.02489107 1.6469996 -3.4349573 3.2303073
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> PhyloName 11.2148132 8.199333 2.1144001 31.6044294
#> units 0.7430287 0.000000 0.7430287 0.7430287
# brms
summary(brms_BL3)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 2.95 0.95 1.38 5.08 1.00 8401 13548
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -0.66 1.88 -4.39 3.15 1.00 19670 22040
#> cSocial_group_size -0.21 0.25 -0.77 0.20 1.00 40230 24813
#> activity_cycledi -0.78 1.50 -3.97 2.04 1.00 21366 21364
#> activity_cyclenoct -0.06 1.53 -3.23 2.86 1.00 20679 21244
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The logit model gave the same qualitative results as the probit model. After the c2 correction, the MCMCglmm and brms estimates were similar, and all 95% credible intervals of the slopes included zero. In conclusion, the models are consistent and provide no evidence that social group size or activity cycle is associated with the presence of red pelage on the body/limbs.
Bivariate model
We jointly analysed two binary traits, the presence of red pelage on the body/limbs and on the head, using bivariate probit (threshold) and logit models with a phylogenetic random effect. Residual variances were fixed at 1 for identification, and the residual cross-trait covariance was fixed at 0. We fitted three specifications: intercept-only, adding centred social group size, and additionally adding activity cycle.
Probit link
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE) # invert covariance matrix for use by MCMCglmm
prior2 <- list(G = list(G1 = list(V = diag(2),
nu = 2, alpha.mu = rep(0, 2),
alpha.V = diag(2) * 10)),
R = list(V = diag(2), fix = 1)
)
system.time(
mcmc_BPB1 <- run_mcmcglmm_chains(cbind(red_pelage_body_limbs, red_pelage_head) ~ trait - 1,
random = ~ us(trait):PhyloName,
rcov = ~ us(trait):units,
family = c("threshold", "threshold"),
data = p_dat,
prior = prior2,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20264026, 20264027, 20264028, 20264029), # one seed per chain (four chains)
nitt = 13000*25,
thin = 10*25,
burnin = 3000*25
)
)
system.time(
mcmc_BPB2 <- run_mcmcglmm_chains(cbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size:trait + trait - 1,
random = ~ us(trait):PhyloName,
rcov = ~ us(trait):units,
family = c("threshold", "threshold"),
data = p_dat,
prior = prior2,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20264126, 20264127, 20264128, 20264129), # one seed per chain (four chains)
nitt = 13000*55,
thin = 10*55,
burnin = 3000*55
)
)
system.time(
mcmc_BPB3 <- run_mcmcglmm_chains(cbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size:trait + activity_cycle:trait + trait - 1,
random = ~ us(trait):PhyloName,
rcov = ~ us(trait):units,
family = c("threshold", "threshold"),
data = p_dat,
prior = prior2,
ginverse = list(PhyloName = inv.phylo$Ainv),
seeds = c(20262026, 20262027, 20262028, 20262029), # one seed per chain (four chains)
nitt = 13000*75,
thin = 10*75,
burnin = 3000*75
)
)
A <- ape::vcv.phylo(p_tree, corr = TRUE)
formula_biPv1 <- bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ 1 +
(1|a|gr(PhyloName, cov = A))
)
default_prior2 <- default_prior(formula_biPv1,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit")
)
system.time(
brms_BPB1 <- brm(formula = formula_biPv1,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = default_prior2,
iter = 25000,
warmup = 5000,
thin = 1,
chains = 4,
cores = 4,
seed = 20271626,
control = list(adapt_delta = 0.95)
)
)
formula_biPv2 <- bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size +
(1|a|gr(PhyloName, cov = A))
# set_rescor(TRUE)
)
default_prior3 <- default_prior(formula_biPv2,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit")
)
system.time(
brms_BPB2 <- brm(formula = formula_biPv2,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = default_prior3,
iter = 35000,
warmup = 15000,
thin = 1,
chains = 4,
cores = 4,
seed = 20273326,
control = list(adapt_delta = 0.99)
)
)
formula_biPv3 <- bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size + activity_cycle +
(1|a|gr(PhyloName, cov = A))
# set_rescor(TRUE)
)
default_prior4 <- default_prior(formula_biPv3,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit")
)
system.time(
brms_BPB3 <- brm(formula = formula_biPv3,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "probit"),
prior = default_prior4,
iter = 35000,
warmup = 25000,
thin = 1,
chains = 4,
cores = 4,
seed = 20273426,
control = list(adapt_delta = 0.99)
)
)Logit link
# prior setting for mcmcglmm
inv.phylo <- inverseA(p_tree, nodes = "ALL", scale = TRUE)
prior <- list(R = list(V = diag(2), fix = 1),
G = list(G1 = list(V = diag(2), nu = 2, alpha.mu = rep(0, 2),
alpha.V = diag(2) * 10)
)
)
# function to run mcmcglmm (four chains); k multiplies the default nitt, thin and burnin
run_mcmcglmm <- function(formula, data, prior, inv_phylo, k, seeds) {
run_mcmcglmm_chains(
fixed = formula,
random = ~ us(trait):PhyloName,
rcov = ~ us(trait):units,
family = c("categorical", "categorical"),
data = data,
prior = prior,
ginverse = list(PhyloName = inv_phylo),
seeds = seeds,
nitt = 13000*k,
thin = 10*k,
burnin = 3000*k
)
}
# model list - mcmcglmm
mcmcglmm_formulas <- list(
formula1 = cbind(red_pelage_body_limbs, red_pelage_head) ~ trait - 1,
formula2 = cbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size:trait + trait - 1,
formula3 = cbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size:trait + activity_cycle:trait + trait - 1
)
# chain lengths used for the results shown below (the two models with predictors
# needed 10 times longer chains than the intercept-only model)
mcmcglmm_k <- c(250, 2500, 2500)
# one seed per chain for each model
mcmcglmm_seeds <- list(c(20264226, 20264227, 20264228, 20264229),
c(20264326, 20264327, 20264328, 20264329),
c(20264426, 20264427, 20264428, 20264429))
#### brms ####
A <- ape::vcv.phylo(p_tree, corr = TRUE)
# function to run brms
run_brms <- function(formula, data, A, prior, iter, warmup, seed) {
brm(
formula = formula,
data = data,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = prior,
iter = iter,
warmup = warmup,
thin = 1,
chains = 4,
cores = 4,
seed = seed,
control = list(adapt_delta = 0.95)
)
}
# model list
brms_formulas <- list(
formula1 = bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ 1 + (1|a|gr(PhyloName, cov = A))),
formula2 = bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size + (1|a|gr(PhyloName, cov = A))),
formula3 = bf(mvbind(red_pelage_body_limbs, red_pelage_head) ~ cSocial_group_size + activity_cycle + (1|a|gr(PhyloName, cov = A)))
)
# iterations used for the results shown below
brms_iter <- c(4000, 4000, 10000)
brms_warmup <- c(3000, 3000, 5000)
brms_seeds <- c(20271926, 20272026, 20272126)
#### run mcmcglmm and brms ####
# mcmcglmm
mcmcglmm_results <- lapply(seq_along(mcmcglmm_formulas), function(i) {
run_mcmcglmm(formula = mcmcglmm_formulas[[i]], data = p_dat, prior = prior,
inv_phylo = inv.phylo$Ainv, k = mcmcglmm_k[i], seeds = mcmcglmm_seeds[[i]])
})
mcmc_BLB1 <- mcmcglmm_results[[1]]; mcmc_BLB2 <- mcmcglmm_results[[2]]; mcmc_BLB3 <- mcmcglmm_results[[3]]
# brms
brms_results <- lapply(seq_along(brms_formulas), function(i) {
formula <- brms_formulas[[i]]
prior2 <- default_prior(formula,
data = p_dat,
data2 = list(A = A),
family = bernoulli(link = "logit"))
run_brms(formula = formula, data = p_dat, A = A, prior = prior2,
iter = brms_iter[i], warmup = brms_warmup[i], seed = brms_seeds[i])
})
brms_BLB1 <- brms_results[[1]]; brms_BLB2 <- brms_results[[2]]; brms_BLB3 <- brms_results[[3]]Results from each model
Probit link model:
Across all three models, the 95% CIs were wide, particularly for the phylogenetic variances and correlations. This indicates substantial uncertainty about the exact magnitude of the phylogenetic effects, even though the overall patterns were consistent. Estimates differed somewhat between MCMCglmm and brms, but their 95% CIs largely overlapped and the direction of the effects was the same, so the conclusions do not depend on the software.
Intercept-only model
summarise_chains(mcmc_BPB1)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitred_pelage_body_limbs -0.9708 1.401 -3.988 1.712 1.000 4043 3961
#> 2 traitred_pelage_head -1.0200 1.511 -4.262 1.855 1.000 4137 3974
#> 3 traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName 8.3070 5.521 2.182 22.540 1.000 4093 3838
#> 4 traitred_pelage_head:traitred_pelage_body_limbs.PhyloName 6.7780 4.220 1.630 17.890 1.001 3698 3844
#> 5 traitred_pelage_body_limbs:traitred_pelage_head.PhyloName 6.7780 4.220 1.630 17.890 1.001 3698 3844
#> 6 traitred_pelage_head:traitred_pelage_head.PhyloName 9.8790 8.013 1.748 31.010 1.002 3501 3154
#> 7 traitred_pelage_body_limbs:traitred_pelage_body_limbs.units 1.0000 0.000 1.000 1.000 NA NA NA
#> 8 traitred_pelage_head:traitred_pelage_body_limbs.units 0.0000 0.000 0.000 0.000 NA NA NA
#> 9 traitred_pelage_body_limbs:traitred_pelage_head.units 0.0000 0.000 0.000 0.000 NA NA NA
#> 10 traitred_pelage_head:traitred_pelage_head.units 1.0000 0.000 1.000 1.000 NA NA NA
posterior_summary(pool_chains(mcmc_BPB1, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs -0.9708052 1.401062 -3.987878 1.711921
#> traitred_pelage_head -1.0197290 1.510545 -4.261988 1.854708
posterior_summary(pool_chains(mcmc_BPB1, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName 8.307067 5.521371 2.182489 22.53912
#> traitred_pelage_head:traitred_pelage_body_limbs.PhyloName 6.777554 4.219994 1.629757 17.88785
#> traitred_pelage_body_limbs:traitred_pelage_head.PhyloName 6.777554 4.219994 1.629757 17.88785
#> traitred_pelage_head:traitred_pelage_head.PhyloName 9.879454 8.013322 1.747521 31.00998
#> traitred_pelage_body_limbs:traitred_pelage_body_limbs.units 1.000000 0.000000 1.000000 1.00000
#> traitred_pelage_head:traitred_pelage_body_limbs.units 0.000000 0.000000 0.000000 0.00000
#> traitred_pelage_body_limbs:traitred_pelage_head.units 0.000000 0.000000 0.000000 0.00000
#> traitred_pelage_head:traitred_pelage_head.units 1.000000 0.000000 1.000000 1.00000
# phylogenetic correlation between the two traits, calculated for each posterior draw
VCV <- pool_chains(mcmc_BPB1, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head:traitred_pelage_body_limbs.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName"] *
VCV[, "traitred_pelage_head:traitred_pelage_head.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.7907993 0.1143167 0.5092832 0.9456057
summary(brms_BPB1)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = probit
#> mu = probit
#> Formula: red_pelage_body_limbs ~ 1 + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ 1 + (1 | a | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 25000; warmup = 5000; thin = 1;
#> total post-warmup draws = 80000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 2.47 0.71 1.33 4.12 1.00 16578 32249
#> sd(redpelagehead_Intercept) 2.54 0.87 1.19 4.57 1.00 15405 32389
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.79 0.12 0.50 0.96 1.00 23288 35303
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.57 1.04 -2.71 1.43 1.00 31674 39749
#> redpelagehead_Intercept -0.63 1.06 -2.76 1.51 1.00 35140 41006
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BPB1)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 6.607593 4.043954 1.766452 16.98019
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 7.183026 5.392812 1.410101 20.86117Both MCMCglmm and brms indicated large phylogenetic variances (body/limbs: 8.31 in MCMCglmm and 6.61 in brms; head: 9.88 and 7.18; posterior means, with brms SDs squared for each draw) and a strong phylogenetic correlation between red pelage on the body/limbs and on the head (0.79, 95% CI 0.51, 0.95 in MCMCglmm; 0.79, 0.50, 0.96 in brms). The intercepts were close to zero with wide intervals, so there is no clear evidence that either trait is more often present or absent at the phylogenetic mean. The two traits show a clear tendency to co-occur along phylogenetic lineages.
Note: In MCMCglmm, the correlation is calculated for each posterior draw as cov(body/limbs, head) / (sd(body/limbs) * sd(head)); brms reports it directly.
One explanatory variable model
summarise_chains(mcmc_BPB2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitred_pelage_body_limbs -0.96720 1.4750 -4.0220 1.7820 1.000 4120 4058
#> 2 traitred_pelage_head -1.00400 1.7040 -4.5230 2.3190 1.000 4152 3932
#> 3 cSocial_group_size:traitred_pelage_body_limbs -0.11290 0.1498 -0.4406 0.1473 1.001 4022 3641
#> 4 cSocial_group_size:traitred_pelage_head 0.07089 0.1269 -0.1754 0.3282 1.000 3919 3841
#> 5 traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName 9.21100 6.6750 2.3960 25.1200 1.000 4041 3873
#> 6 traitred_pelage_head:traitred_pelage_body_limbs.PhyloName 7.79500 5.2790 1.7900 21.3000 1.000 3673 3212
#> 7 traitred_pelage_body_limbs:traitred_pelage_head.PhyloName 7.79500 5.2790 1.7900 21.3000 1.000 3673 3212
#> 8 traitred_pelage_head:traitred_pelage_head.PhyloName 11.82000 12.3100 2.0100 39.2400 1.000 3382 3181
#> 9 traitred_pelage_body_limbs:traitred_pelage_body_limbs.units 1.00000 0.0000 1.0000 1.0000 NA NA NA
#> 10 traitred_pelage_head:traitred_pelage_body_limbs.units 0.00000 0.0000 0.0000 0.0000 NA NA NA
#> 11 traitred_pelage_body_limbs:traitred_pelage_head.units 0.00000 0.0000 0.0000 0.0000 NA NA NA
#> 12 traitred_pelage_head:traitred_pelage_head.units 1.00000 0.0000 1.0000 1.0000 NA NA NA
posterior_summary(pool_chains(mcmc_BPB2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs -0.96719299 1.4749949 -4.0222380 1.7815470
#> traitred_pelage_head -1.00352994 1.7041495 -4.5228742 2.3185852
#> cSocial_group_size:traitred_pelage_body_limbs -0.11291788 0.1497614 -0.4405912 0.1473441
#> cSocial_group_size:traitred_pelage_head 0.07088552 0.1268913 -0.1753927 0.3282399
posterior_summary(pool_chains(mcmc_BPB2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName 9.211426 6.674699 2.396314 25.12423
#> traitred_pelage_head:traitred_pelage_body_limbs.PhyloName 7.795193 5.279058 1.789508 21.29644
#> traitred_pelage_body_limbs:traitred_pelage_head.PhyloName 7.795193 5.279058 1.789508 21.29644
#> traitred_pelage_head:traitred_pelage_head.PhyloName 11.815168 12.306718 2.009724 39.24456
#> traitred_pelage_body_limbs:traitred_pelage_body_limbs.units 1.000000 0.000000 1.000000 1.00000
#> traitred_pelage_head:traitred_pelage_body_limbs.units 0.000000 0.000000 0.000000 0.00000
#> traitred_pelage_body_limbs:traitred_pelage_head.units 0.000000 0.000000 0.000000 0.00000
#> traitred_pelage_head:traitred_pelage_head.units 1.000000 0.000000 1.000000 1.00000
# phylogenetic correlation between the two traits, calculated for each posterior draw
VCV <- pool_chains(mcmc_BPB2, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head:traitred_pelage_body_limbs.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName"] *
VCV[, "traitred_pelage_head:traitred_pelage_head.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.8011676 0.1060227 0.5378298 0.9475776
summary(brms_BPB2)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = probit
#> mu = probit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ cSocial_group_size + (1 | a | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 35000; warmup = 15000; thin = 1;
#> total post-warmup draws = 80000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 2.56 0.75 1.37 4.28 1.00 14184 28134
#> sd(redpelagehead_Intercept) 2.70 0.95 1.28 4.95 1.00 13327 25874
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.80 0.12 0.51 0.96 1.00 21203 31353
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.58 1.05 -2.75 1.47 1.00 26400 37932
#> redpelagehead_Intercept -0.61 1.10 -2.83 1.59 1.00 29185 39855
#> redpelagebodylimbs_cSocial_group_size -0.11 0.15 -0.43 0.15 1.00 71521 53037
#> redpelagehead_cSocial_group_size 0.06 0.12 -0.17 0.29 1.00 64476 52832
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BPB2)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 7.103525 4.560209 1.877703 18.33772
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 8.196391 6.703208 1.633732 24.51498Adding social group size as a predictor did not change the results in any important way. The estimated slopes of group size were small, and their 95% CIs included zero, so there is no evidence that species living in larger or smaller groups are more or less likely to have red pelage. The slopes of group size were −0.11 (95% CI −0.44, 0.15) for body/limbs and 0.07 (−0.18, 0.33) for head in MCMCglmm, and −0.11 (−0.43, 0.15) and 0.06 (−0.17, 0.29) in brms. The strong positive phylogenetic correlation between the two body regions remained (0.80, 95% CI 0.54, 0.95 in MCMCglmm; 0.80, 0.51, 0.96 in brms): the two traits show strongly shared phylogenetic structure after accounting for group size. The first four-chain brms fit of this model (adapt_delta = 0.95) had 2 divergent transitions; the fit shown uses adapt_delta = 0.99 and has none.
Two explanatory variables model
summarise_chains(mcmc_BPB3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitred_pelage_body_limbs -1.23600 2.0280 -5.6100 2.6210 1.000 3936 3644
#> 2 traitred_pelage_head -1.13400 3.0870 -7.1860 3.5370 1.001 3812 1986
#> 3 cSocial_group_size:traitred_pelage_body_limbs -0.11400 0.1620 -0.4648 0.1628 1.000 4020 3769
#> 4 cSocial_group_size:traitred_pelage_head 0.09342 0.1881 -0.1909 0.4505 1.001 2723 1633
#> 5 traitred_pelage_body_limbs:activity_cycledi -0.20020 1.1680 -2.6310 1.9810 0.999 3903 3792
#> 6 traitred_pelage_head:activity_cycledi 0.02743 1.5860 -2.4820 2.9840 1.001 3671 2049
#> 7 traitred_pelage_body_limbs:activity_cyclenoct 0.41870 1.2030 -1.9440 2.7400 1.000 3993 3921
#> 8 traitred_pelage_head:activity_cyclenoct -0.30980 1.6150 -3.0970 2.7560 1.000 3992 2770
#> 9 traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName 12.41000 10.9800 2.8620 39.5500 1.001 4019 3704
#> 10 traitred_pelage_head:traitred_pelage_body_limbs.PhyloName 11.99000 11.9800 2.5240 40.1900 1.001 1751 908
#> 11 traitred_pelage_body_limbs:traitred_pelage_head.PhyloName 11.99000 11.9800 2.5240 40.1900 1.001 1751 908
#> 12 traitred_pelage_head:traitred_pelage_head.PhyloName 27.65000 86.1800 2.7090 117.8000 1.002 1558 803
#> 13 traitred_pelage_body_limbs:traitred_pelage_body_limbs.units 1.00000 0.0000 1.0000 1.0000 NA NA NA
#> 14 traitred_pelage_head:traitred_pelage_body_limbs.units 0.00000 0.0000 0.0000 0.0000 NA NA NA
#> 15 traitred_pelage_body_limbs:traitred_pelage_head.units 0.00000 0.0000 0.0000 0.0000 NA NA NA
#> 16 traitred_pelage_head:traitred_pelage_head.units 1.00000 0.0000 1.0000 1.0000 NA NA NA
# phylogenetic correlation between the two traits, calculated for each pooled draw
VCV <- pool_chains(mcmc_BPB3, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head:traitred_pelage_body_limbs.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs:traitred_pelage_body_limbs.PhyloName"] *
VCV[, "traitred_pelage_head:traitred_pelage_head.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.8018513 0.1034081 0.5448131 0.9485717
summary(brms_BPB3)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = probit
#> mu = probit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ cSocial_group_size + activity_cycle + (1 | a | gr(PhyloName, cov = A))
#> Data: p_dat (Number of observations: 265)
#> Draws: 4 chains, each with iter = 35000; warmup = 25000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 2.81 0.84 1.52 4.79 1.00 8668 17582
#> sd(redpelagehead_Intercept) 3.06 1.18 1.39 5.88 1.00 7247 12986
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.80 0.11 0.52 0.96 1.00 14223 19540
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.64 1.43 -3.50 2.22 1.00 23443 24664
#> redpelagehead_Intercept -0.40 1.53 -3.52 2.56 1.00 26374 23913
#> redpelagebodylimbs_cSocial_group_size -0.11 0.15 -0.43 0.16 1.00 47500 30667
#> redpelagebodylimbs_activity_cycledi -0.15 1.03 -2.31 1.79 1.00 25209 25216
#> redpelagebodylimbs_activity_cyclenoct 0.36 1.08 -1.84 2.46 1.00 25537 25734
#> redpelagehead_cSocial_group_size 0.07 0.12 -0.17 0.31 1.00 44513 28405
#> redpelagehead_activity_cycledi -0.07 1.09 -2.08 2.24 1.00 26455 21818
#> redpelagehead_activity_cyclenoct -0.45 1.20 -2.74 2.04 1.00 24890 20360
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BPB3)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 8.625842 5.64495 2.310807 22.989
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 10.76857 10.35642 1.928138 34.61278When both social group size and activity cycle were included, neither predictor showed strong or consistent effects; the estimated coefficients were uncertain and their 95% CIs included zero. As in the previous models, the phylogenetic variances were large and the phylogenetic correlation between the two traits was strongly positive (0.80, 95% CI 0.54, 0.95 in MCMCglmm; 0.80, 0.52, 0.96 in brms), i.e. the traits show strongly shared phylogenetic structure after accounting for the included predictors. The MCMCglmm variance for head has a very heavy upper tail (posterior mean 27.7, 95% CI 2.7, 117.8), so its posterior mean is not a useful summary; the correlation is much more stable. The first four-chain brms fit (adapt_delta = 0.95) had 10 divergent transitions; the fit shown uses adapt_delta = 0.99 and has none.
Logit link model:
In the logit link model, we need to correct the variances and estimates in the results from MCMCglmm…
Intercept-only model
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmc_BLB1, "Sol") / sqrt(1 + c2) # c2-corrected fixed effects
res_2 <- pool_chains(mcmc_BLB1, "VCV") / (1 + c2) # c2-corrected (co)variances
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2 -1.538400 2.343659 -6.401894 2.775832
#> traitred_pelage_head.2 -1.727627 2.510919 -7.009355 3.153167
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName 23.3709785 16.50908 5.9037795 62.9597479
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName 19.3373184 11.81050 4.5171525 49.7762491
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.PhyloName 19.3373184 11.81050 4.5171525 49.7762491
#> traitred_pelage_head.2:traitred_pelage_head.2.PhyloName 26.7811431 21.03237 4.8152030 81.3117865
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.units 0.7430287 0.00000 0.7430287 0.7430287
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_head.2:traitred_pelage_head.2.units 0.7430287 0.00000 0.7430287 0.7430287
# phylogenetic correlation (the c2 correction cancels out), calculated for each posterior draw
VCV <- pool_chains(mcmc_BLB1, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName"] *
VCV[, "traitred_pelage_head.2:traitred_pelage_head.2.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.8157489 0.1104027 0.5340097 0.961278
summary(brms_BLB1)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = logit
#> mu = logit
#> Formula: red_pelage_body_limbs ~ 1 + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ 1 + (1 | a | gr(PhyloName, cov = A))
#> Data: d$data (Number of observations: 265)
#> Draws: 4 chains, each with iter = 4000; warmup = 3000; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 3.87 1.13 2.03 6.35 1.01 1002 1856
#> sd(redpelagehead_Intercept) 3.94 1.29 1.86 6.95 1.00 1122 2085
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.78 0.13 0.47 0.95 1.00 1227 1735
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.66 1.40 -3.52 2.02 1.00 1901 2039
#> redpelagehead_Intercept -0.81 1.40 -3.74 1.95 1.00 2250 2141
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BLB1)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 16.23712 10.2501 4.1348 40.36687
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 17.18665 12.05333 3.455389 48.33896Intercepts were close to zero with very wide intervals in both MCMCglmm and brms. After the c2 correction, the MCMCglmm phylogenetic variances (23.4 and 26.8) are somewhat larger than those of brms (16.2 and 17.2, SDs squared for each draw), but both packages estimate a strong phylogenetic correlation between the traits (0.82, 95% CI 0.53, 0.96 in MCMCglmm; 0.78, 0.47, 0.95 in brms). The estimates are uncertain and the intervals are wide. Note that the first two brms bivariate logit models use short chains (1,000 post-warm-up draws per chain); their bulk ESS values (about 900–1,100 for the standard deviations) are nevertheless adequate.
One explanatory variable model
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmc_BLB2, "Sol") / sqrt(1 + c2) # c2-corrected fixed effects
res_2 <- pool_chains(mcmc_BLB2, "VCV") / (1 + c2) # c2-corrected (co)variances
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2 -1.5702453 2.4764688 -6.7138058 3.0499442
#> traitred_pelage_head.2 -1.7010488 2.6784182 -7.2502063 3.4286344
#> cSocial_group_size:traitred_pelage_body_limbs.2 -0.2048445 0.2633526 -0.7886143 0.2475186
#> cSocial_group_size:traitred_pelage_head.2 0.1198560 0.2113202 -0.2903861 0.5502658
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName 25.2751663 22.61078 6.1696541 68.3260727
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName 21.4473729 13.57393 5.1253605 55.0801368
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.PhyloName 21.4473729 13.57393 5.1253605 55.0801368
#> traitred_pelage_head.2:traitred_pelage_head.2.PhyloName 31.3093527 28.99531 5.2644726 99.5959061
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.units 0.7430287 0.00000 0.7430287 0.7430287
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_head.2:traitred_pelage_head.2.units 0.7430287 0.00000 0.7430287 0.7430287
# phylogenetic correlation (the c2 correction cancels out), calculated for each posterior draw
VCV <- pool_chains(mcmc_BLB2, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName"] *
VCV[, "traitred_pelage_head.2:traitred_pelage_head.2.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.818437 0.1074138 0.5516463 0.9582246
summary(brms_BLB2)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = logit
#> mu = logit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ cSocial_group_size + (1 | a | gr(PhyloName, cov = A))
#> Data: d$data (Number of observations: 265)
#> Draws: 4 chains, each with iter = 4000; warmup = 3000; thin = 1;
#> total post-warmup draws = 4000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 3.97 1.17 2.12 6.70 1.01 910 1778
#> sd(redpelagehead_Intercept) 4.09 1.41 1.89 7.29 1.01 931 1947
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.79 0.12 0.48 0.96 1.00 1624 2128
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.69 1.40 -3.64 1.95 1.00 2486 2048
#> redpelagehead_Intercept -0.80 1.44 -3.63 2.07 1.00 3046 2665
#> redpelagebodylimbs_cSocial_group_size -0.21 0.26 -0.80 0.23 1.00 4126 2922
#> redpelagehead_cSocial_group_size 0.11 0.20 -0.29 0.50 1.00 4609 3168
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BLB2)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 17.12149 10.93993 4.483168 44.9514
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 18.68294 13.93591 3.586927 53.08357Intercepts for both traits were close to zero with very wide intervals. The slopes of social group size were small, and their 95% CIs included zero. The phylogenetic variances were large, and the phylogenetic correlation remained strong in both packages (0.82 in MCMCglmm and 0.79 in brms). Adding social group size did not materially change the results.
Two explanatory variables model
c2 <- (16 * sqrt(3) / (15 * pi))^2
res_1 <- pool_chains(mcmc_BLB3, "Sol") / sqrt(1 + c2) # c2-corrected fixed effects
res_2 <- pool_chains(mcmc_BLB3, "VCV") / (1 + c2) # c2-corrected (co)variances
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2 -2.01978653 3.2915916 -9.1469007 4.1734795
#> traitred_pelage_head.2 -1.69464732 3.8261078 -9.9262708 5.3481401
#> cSocial_group_size:traitred_pelage_body_limbs.2 -0.19014650 0.2732778 -0.7779024 0.2806582
#> cSocial_group_size:traitred_pelage_head.2 0.13337833 0.2412803 -0.3297356 0.6278760
#> traitred_pelage_body_limbs.2:activity_cycledi -0.23081778 1.8927376 -4.0622782 3.3942611
#> traitred_pelage_head.2:activity_cycledi -0.08790943 2.1381887 -4.0009950 4.3751929
#> traitred_pelage_body_limbs.2:activity_cyclenoct 0.78928714 2.0077535 -3.1717170 4.7216923
#> traitred_pelage_head.2:activity_cyclenoct -0.69201136 2.3899318 -5.1401032 4.1188985
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName 32.9618484 26.24128 7.5102361 96.9329944
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName 29.0804093 20.84829 6.7349286 79.1905439
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.PhyloName 29.0804093 20.84829 6.7349286 79.1905439
#> traitred_pelage_head.2:traitred_pelage_head.2.PhyloName 46.5264266 84.15314 7.4320223 166.1163890
#> traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.units 0.7430287 0.00000 0.7430287 0.7430287
#> traitred_pelage_head.2:traitred_pelage_body_limbs.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_body_limbs.2:traitred_pelage_head.2.units 0.0000000 0.00000 0.0000000 0.0000000
#> traitred_pelage_head.2:traitred_pelage_head.2.units 0.7430287 0.00000 0.7430287 0.7430287
# phylogenetic correlation (the c2 correction cancels out), calculated for each posterior draw
VCV <- pool_chains(mcmc_BLB3, "VCV")
corr_phylo <- VCV[, "traitred_pelage_head.2:traitred_pelage_body_limbs.2.PhyloName"] /
sqrt(VCV[, "traitred_pelage_body_limbs.2:traitred_pelage_body_limbs.2.PhyloName"] *
VCV[, "traitred_pelage_head.2:traitred_pelage_head.2.PhyloName"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.8250156 0.09964183 0.5677827 0.9590986
summary(brms_BLB3)
#> Family: MV(bernoulli, bernoulli)
#> Links: mu = logit
#> mu = logit
#> Formula: red_pelage_body_limbs ~ cSocial_group_size + activity_cycle + (1 | a | gr(PhyloName, cov = A))
#> red_pelage_head ~ cSocial_group_size + activity_cycle + (1 | a | gr(PhyloName, cov = A))
#> Data: d$data (Number of observations: 265)
#> Draws: 4 chains, each with iter = 10000; warmup = 5000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~PhyloName (Number of levels: 265)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(redpelagebodylimbs_Intercept) 4.39 1.35 2.31 7.54 1.00 4724 8986
#> sd(redpelagehead_Intercept) 4.61 1.69 2.11 8.64 1.00 4565 9101
#> cor(redpelagebodylimbs_Intercept,redpelagehead_Intercept) 0.79 0.12 0.49 0.96 1.00 8997 12114
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> redpelagebodylimbs_Intercept -0.73 2.11 -4.96 3.43 1.00 18827 14186
#> redpelagehead_Intercept -0.35 2.18 -4.83 3.82 1.00 20396 13815
#> redpelagebodylimbs_cSocial_group_size -0.19 0.26 -0.77 0.25 1.00 26650 15053
#> redpelagebodylimbs_activity_cycledi -0.22 1.67 -3.64 2.97 1.00 17596 14124
#> redpelagebodylimbs_activity_cyclenoct 0.56 1.76 -2.96 4.03 1.00 16836 13449
#> redpelagehead_cSocial_group_size 0.11 0.21 -0.31 0.52 1.00 28089 14719
#> redpelagehead_activity_cycledi -0.17 1.74 -3.41 3.52 1.00 19083 13687
#> redpelagehead_activity_cyclenoct -0.96 1.88 -4.59 2.93 1.00 19175 14236
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
# brms phylogenetic variances (SD squared for each draw)
draws <- as_draws_df(brms_BLB3)
posterior_summary(draws$sd_PhyloName__redpelagebodylimbs_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 21.08907 14.29384 5.321739 56.90424
posterior_summary(draws$sd_PhyloName__redpelagehead_Intercept^2)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 24.11855 20.20791 4.457318 74.58675With both predictors, the intervals are wide in both packages (e.g. the c2-corrected MCMCglmm intercept for body/limbs is −2.02, 95% CI −9.15, 4.17), but the four MCMCglmm chains agree (R-hat < 1.01) and the estimates are consistent with those of brms. The effects of social group size and activity cycle are small relative to their uncertainty, and all of their 95% CIs include zero in both packages. The phylogenetic variances are large and very uncertain (c2-corrected MCMCglmm: 33.0 [7.5, 96.9] for body/limbs and 46.5 [7.4, 166.1] for head; brms: 21.1 [5.3, 56.9] and 24.1 [4.5, 74.6]). MCMCglmm gives larger values with heavier upper tails, which reflects the different priors on the variance components. The phylogenetic correlation between the two traits remains strongly positive (0.83 [0.57, 0.96] in MCMCglmm; 0.79 [0.49, 0.96] in brms). Overall, neither social group size nor activity cycle emerges as an important predictor of red pelage, whereas both packages show a strong positive phylogenetic correlation between the traits.
3. Ordinal (threshold) models (ordered multinomial model)
For the ordinal (threshold) and nominal models, we show two realistic examples each. As explained in Box 2 of the main text, MCMCglmm and brms use different parametrisations of the threshold model. At first sight, the outputs about the thresholds (cutpoints) may look difficult, but we will guide you step by step through understanding and interpreting them. By the end of this section, you will be able to compare the threshold estimates from both models and understand their implications.
Explanation of dataset
We used the dataset from AVONET (Tobias et al. (2022)) and the phylogenetic tree from BirdTree.
For the first example, we tested the relationships between migration level (response variable) and body mass and habitat density in hawks and eagles (Accipitridae; 136 species).
For the second example, we investigated whether habitat density within the family Phasianidae (179 species) is associated with tail length and diet (herbivory).
Dataset for example 1
dat <- read.csv(here("data", "bird body mass", "accipitridae_sampled.csv"))
dat <- dat %>%
mutate(across(c(Trophic.Level, Trophic.Niche, Primary.Lifestyle, Migration, Habitat, Species.Status), as.factor))
# rename: numbers to descriptive name
dat$Migration_ordered <- factor(dat$Migration, levels = c("sedentary", "partially_migratory", "migratory"), ordered = TRUE)
dat <- dat %>%
mutate(Habitat.Density = case_when(
Habitat.Density == 1 ~ "dense",
Habitat.Density == 2 ~ "semi-open",
Habitat.Density == 3 ~ "open",
TRUE ~ as.character(Habitat.Density)
))
table(dat$Habitat.Density)
dat$logMass <- log(dat$Mass)
hist(dat$logMass)
boxplot(logMass ~ Habitat.Density, data = dat)
summary(dat)
trees <- read.nexus(here("data", "bird body mass", "accipitridae_sampled.nex"))
tree <- trees[[1]]
summary(dat)Example 1
Intercept-only model
MCMCglmm
When using MCMCglmm for ordinal data, you can choose between two options for the family parameter: "threshold" and "ordinal". These options differ in how they handle residual variances and error distributions.
We generally recommend using family = "threshold" for the following reasons: it corresponds directly to the standard probit (threshold) model with a residual variance of 1, so no correction of the outputs is necessary, and it usually mixes better.
We show both models throughout this section.
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)))
system.time(
mcmcglmm_T1_1 <- run_mcmcglmm_chains(Migration_ordered ~ 1,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "threshold",
data = dat,
prior = prior1,
seeds = c(20264526, 20264527, 20264528, 20264529), # one seed per chain (four chains)
nitt = 13000*40,
thin = 10*40,
burnin = 3000*40
)
)
system.time(
mcmcglmm_O1_1 <- run_mcmcglmm_chains(Migration_ordered ~ 1,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "ordinal",
data = dat,
prior = prior1,
seeds = c(20264626, 20264627, 20264628, 20264629), # one seed per chain (four chains)
nitt = 13000*40,
thin = 10*40,
burnin = 3000*40
)
)For the ordinal family, the latent variable has two error terms, the units residual (fixed at 1) and the standard normal error of the probit link (variance 1). To express the estimates on the standard probit scale (total residual variance 1), we apply the following correction:
c2 <- 1
res_1 <- model$Sol / sqrt(1+c2) # for fixed effects
res_2 <- model$VCV / (1+c2) # for variance componentssummarise_chains(mcmcglmm_T1_1) # pooled draws of four chains; 95% equal-tailed intervals
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.3108 0.5248 -0.760900 1.434 1 4144 3972
#> 2 Phylo 1.1720 1.6200 0.001486 5.738 1 4092 4057
#> 3 units 1.0000 0.0000 1.000000 1.000 NA NA NA
#> 4 cutpoint.traitMigration_ordered.1 0.9913 0.1755 0.707600 1.404 1 4028 3819
posterior_summary(pool_chains(mcmcglmm_T1_1, "VCV")) # 95% CI
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.171787 1.620105 0.001485821 5.73793
#> units 1.000000 0.000000 1.000000000 1.00000
posterior_summary(pool_chains(mcmcglmm_T1_1, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.3108338 0.5247659 -0.7609432 1.433756
posterior_summary(pool_chains(mcmcglmm_T1_1, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 0.9912625 0.1755448 0.7075925 1.404084
summarise_chains(mcmcglmm_O1_1) # pooled draws of four chains; 95% equal-tailed intervals
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.4637 0.7321 -0.958200 2.110 1.001 3745 3971
#> 2 Phylo 2.1220 3.1020 0.003452 10.210 1.000 3640 3835
#> 3 units 1.0000 0.0000 1.000000 1.000 NA NA NA
#> 4 cutpoint.traitMigration_ordered.1 1.3990 0.2409 1.014000 1.936 1.000 3850 3634
posterior_summary(pool_chains(mcmcglmm_O1_1, "VCV")) # 95% CI
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 2.121944 3.101576 0.003451651 10.20916
#> units 1.000000 0.000000 1.000000000 1.00000
posterior_summary(pool_chains(mcmcglmm_O1_1, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.4636583 0.7320707 -0.958243 2.11015
c2 <- 1
res_1 <- pool_chains(mcmcglmm_O1_1, "Sol") / sqrt(1+c2) # for fixed effects
res_2 <- pool_chains(mcmcglmm_O1_1, "VCV") / (1+c2) # for variance components
res_3 <- pool_chains(mcmcglmm_O1_1, "CP") / sqrt(1+c2) # for cutpoint
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.3278559 0.5176521 -0.6775802 1.492102
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.060972 1.550788 0.001725826 5.104579
#> units 0.500000 0.000000 0.500000000 0.500000
posterior_summary(res_3)
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 0.9892338 0.1703678 0.7169798 1.368876The raw estimates of the ordinal model are larger than those of the threshold model because they are on a scale with a total residual variance of 2; after the correction, the two models give similar estimates. The four chains of both models agree (R-hat < 1.01, bulk and tail ESS > 3,600), although ordinal models in MCMCglmm generally mix more slowly than threshold models and needed longer chains. As in the binary models, the residual variance is fixed at 1: the model did not estimate the residual variance (R-structure).
Look at the output more closely: only one cutpoint is reported, although our response variable has three ordered categories. As explained in the main text, MCMCglmm fixes the first cutpoint at 0, so the intercept is estimated relative to this first threshold (and the reported cutpoint is the second threshold).
brms
The family argument is set to cumulative() with link = "probit", which uses the standard probit parametrisation where the residual variance is fixed at 1. Since this is the standard parametrisation for ordinal probit regression, no correcting of coefficients is necessary.
A <- ape::vcv.phylo(tree, corr = TRUE)
default_priors <- default_prior(
Migration_ordered ~ 1 + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
# Fit the model
system.time(
brms_OT1_1 <- brm(
formula = Migration_ordered ~ 1 + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors,
iter = 20000,
warmup = 10000,
thin = 1,
chains = 4,
cores = 4,
seed = 20272526,
control = list(adapt_delta = 0.999)
)
)summary(brms_OT1_1)
#> Family: cumulative
#> Links: mu = probit
#> Formula: Migration_ordered ~ 1 + (1 | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 136)
#> Draws: 4 chains, each with iter = 20000; warmup = 10000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 136)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.86 0.61 0.04 2.29 1.00 2933 6424
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -0.33 0.48 -1.38 0.64 1.00 20259 13831
#> Intercept[2] 0.66 0.48 -0.27 1.75 1.00 20358 15823
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).In brms, you can see two intercepts and no cutpoint in the output. These intercepts are the cutpoints (thresholds) themselves: brms fixes the linear predictor’s intercept at 0 and estimates both thresholds. The two parametrisations are equivalent and imply very similar predicted proportions of species in each category, as shown below.
Probabilities
We can obtain the probabilities of each category (migration level: sedentary, partially migratory, migratory) using pnorm(). With the probit link, the probability of the lowest category is \(\Phi(\tau_1 - \eta)\), that of the middle category is \(\Phi(\tau_2 - \eta) - \Phi(\tau_1 - \eta)\), and that of the highest category is \(1 - \Phi(\tau_2 - \eta)\). Here \(\tau_1 < \tau_2\) are the thresholds and \(\eta\) is the linear predictor. In MCMCglmm, \(\tau_1 = 0\), \(\tau_2\) is the reported cutpoint, and \(\eta\) includes the intercept. In brms, \(\tau_1\) and \(\tau_2\) are the two intercepts and \(\eta\) has no intercept.
We made a simple function for this and use it for both packages. We calculate the probabilities for every posterior draw and then summarise them. The probabilities refer to a species whose phylogenetic random effect is zero (i.e. at the phylogenetic mean); they are not averaged over species.
# Category probabilities of a three-category probit threshold model.
# cutpoint0, cutpoint1: lower and upper thresholds; l: linear predictor.
# The arguments can be vectors of posterior draws (one value per draw).
calculate_probabilities <- function(cutpoint0, cutpoint1, l,
labels = c("sedentary", "partially_migratory", "migratory")) {
probs <- cbind(pnorm(cutpoint0 - l),
pnorm(cutpoint1 - l) - pnorm(cutpoint0 - l),
1 - pnorm(cutpoint1 - l))
colnames(probs) <- labels
probs
}# MCMCglmm: first cutpoint fixed at 0, second cutpoint estimated, intercept in the linear predictor
probabilities_mcmcglmm <- calculate_probabilities(0, pool_chains(mcmcglmm_T1_1, "CP")[, 1], pool_chains(mcmcglmm_T1_1, "Sol")[, "(Intercept)"])
posterior_summary(probabilities_mcmcglmm)
#> Estimate Est.Error Q2.5 Q97.5
#> sedentary 0.3906299 0.16573527 0.07582100 0.7766545
#> partially_migratory 0.3369165 0.07216428 0.16558423 0.4722490
#> migratory 0.2724537 0.14589284 0.03023044 0.6313140
# brms: both cutpoints estimated (Intercept[1], Intercept[2]), no intercept in the linear predictor
draws <- as_draws_df(brms_OT1_1)
probabilities_brms <- calculate_probabilities(draws$`b_Intercept[1]`, draws$`b_Intercept[2]`, 0)
posterior_summary(probabilities_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> sedentary 0.3838747 0.15607591 0.08370244 0.7385190
#> partially_migratory 0.3410405 0.06677686 0.19473741 0.4726157
#> migratory 0.2750848 0.13777236 0.03986000 0.6075200The posterior mean probabilities are 0.39 (sedentary), 0.34 (partially migratory) and 0.27 (migratory) in MCMCglmm, and 0.38, 0.34 and 0.28 in brms. Although MCMCglmm and brms use the true-intercept and the zero-intercept parametrisations, respectively, the implied probabilities are very similar (see Box 2 in the main text). The wide 95% CIs (e.g. 0.08 to 0.78 for P(sedentary) in MCMCglmm) reflect the uncertainty in the intercept and in the phylogenetic variance.
Phylogenetic signals
# MCMCglmm, threshold family: latent-scale residual variance = 1
h2_mcmcglmm_T <- pool_chains(mcmcglmm_T1_1, "VCV")[, "Phylo"] / (pool_chains(mcmcglmm_T1_1, "VCV")[, "Phylo"] + 1)
posterior_summary(h2_mcmcglmm_T)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.3825315 0.2643585 0.001483617 0.8515861
# MCMCglmm, ordinal family: correct the variance first (c2 = 1), then use the same definition
c2 <- 1
var_phylo_O <- pool_chains(mcmcglmm_O1_1, "VCV")[, "Phylo"] / (1 + c2)
h2_mcmcglmm_O <- var_phylo_O / (var_phylo_O + 1)
posterior_summary(h2_mcmcglmm_O)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.3683238 0.257143 0.001722852 0.8361885
# brms: probit latent-scale residual variance = 1
h2_brms_OT <- as_draws_df(brms_OT1_1) %>%
mutate(h2 = sd_Phylo__Intercept^2 / (sd_Phylo__Intercept^2 + 1)) %>%
pull(h2)
posterior_summary(h2_brms_OT)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.3766213 0.2602529 0.001679635 0.8399828The proportion of the latent-scale variance attributed to phylogeny is similar in the three models: 0.38 (95% CI 0.00, 0.85) for the MCMCglmm threshold model, 0.37 (0.00, 0.84) for the MCMCglmm ordinal model after the correction, and 0.38 (0.00, 0.84) for brms. The posterior means suggest a moderate phylogenetic signal in migration level, but the estimates are very uncertain: the intervals range from almost zero to high values. The variation that is not attributed to phylogeny is residual variation on the latent scale; its causes are not identified by this model.
One continuous explanatory variable model
The model using MCMCglmm is
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)))
system.time(
mcmcglmm_T1_2 <- run_mcmcglmm_chains(Migration_ordered ~ logMass,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "threshold",
data = dat,
prior = prior1,
seeds = c(20264726, 20264727, 20264728, 20264729), # one seed per chain (four chains)
nitt = 13000*45,
thin = 10*45,
burnin = 3000*45
)
)
system.time(
mcmcglmm_O1_2 <- run_mcmcglmm_chains(Migration_ordered ~ logMass,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "ordinal",
data = dat,
prior = prior1,
seeds = c(20264826, 20264827, 20264828, 20264829), # one seed per chain (four chains)
nitt = 13000*60,
thin = 10*60,
burnin = 3000*60
)
)For brms…
A <- ape::vcv.phylo(tree, corr = TRUE)
default_priors2 <- default_prior(
Migration_ordered ~ logMass + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
# Fit the model
system.time(
brms_OT1_2 <- brm(
formula = Migration_ordered ~ logMass + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors2,
iter = 20000,
warmup = 10000,
thin = 1,
chains = 4,
cores = 4,
seed = 20272626,
control = list(adapt_delta = 0.999)
)
)# MCMCglmm
summarise_chains(mcmcglmm_T1_2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.84720 1.1390 -1.489000 3.2410 1 3778 3677
#> 2 logMass -0.07311 0.1336 -0.341700 0.1911 1 3744 3671
#> 3 Phylo 1.52200 2.2030 0.002314 7.3210 1 3828 3877
#> 4 units 1.00000 0.0000 1.000000 1.0000 NA NA NA
#> 5 cutpoint.traitMigration_ordered.1 1.02300 0.1943 0.720000 1.4760 1 3818 3713
posterior_summary(pool_chains(mcmcglmm_T1_2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.84715067 1.1389852 -1.4888332 3.2412696
#> logMass -0.07310501 0.1336424 -0.3417473 0.1911071
posterior_summary(pool_chains(mcmcglmm_T1_2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.521726 2.202714 0.002314321 7.321273
#> units 1.000000 0.000000 1.000000000 1.000000
posterior_summary(pool_chains(mcmcglmm_T1_2, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 1.022506 0.1943492 0.7200179 1.475685
summarise_chains(mcmcglmm_O1_2) # pooled draws of four chains; 95% equal-tailed intervals
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 1.2300 1.5980 -1.800000 4.6620 1.002 3874 3835
#> 2 logMass -0.1052 0.1876 -0.477100 0.2527 1.000 3908 3972
#> 3 Phylo 2.7160 3.8890 0.003291 12.8300 1.001 3877 3931
#> 4 units 1.0000 0.0000 1.000000 1.0000 NA NA NA
#> 5 cutpoint.traitMigration_ordered.1 1.4250 0.2649 1.010000 2.0340 1.000 3861 3737
posterior_summary(pool_chains(mcmcglmm_O1_2, "VCV")) # 95% CI
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 2.716335 3.8887 0.003290997 12.83115
#> units 1.000000 0.0000 1.000000000 1.00000
posterior_summary(pool_chains(mcmcglmm_O1_2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 1.2299533 1.5975621 -1.8002910 4.6622096
#> logMass -0.1052461 0.1875512 -0.4771215 0.2527177
c2 <- 1
res_1 <- pool_chains(mcmcglmm_O1_2, "Sol") / sqrt(1+c2) # for fixed effects
res_2 <- pool_chains(mcmcglmm_O1_2, "VCV") / (1+c2) # for variance components
res_3 <- pool_chains(mcmcglmm_O1_2, "CP") / sqrt(1+c2)
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.86970830 1.1296470 -1.2729979 3.2966800
#> logMass -0.07442024 0.1326187 -0.3373759 0.1786984
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.358167 1.94435 0.001645499 6.415576
#> units 0.500000 0.00000 0.500000000 0.500000
posterior_summary(res_3)
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 1.007521 0.1873045 0.7145004 1.437937
#brms
summary(brms_OT1_2)
#> Family: cumulative
#> Links: mu = probit
#> Formula: Migration_ordered ~ logMass + (1 | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 136)
#> Draws: 4 chains, each with iter = 20000; warmup = 10000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 136)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.93 0.64 0.04 2.41 1.00 3062 6369
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -0.85 1.08 -3.11 1.28 1.00 26327 16066
#> Intercept[2] 0.16 1.07 -2.01 2.37 1.00 27603 17560
#> logMass -0.07 0.13 -0.35 0.19 1.00 34306 20111
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).In both packages, the 95% credible interval of the slope of logMass includes zero (MCMCglmm threshold model: −0.07, 95% CI −0.34, 0.19; brms: −0.07, −0.35, 0.19), so there is no clear evidence that body mass is associated with migration level.
To calculate the category probabilities from this model, we need to choose a value of the predictor. We use the mean of logMass; at logMass = 0 (a body mass of 1 g), the intercept would be an extrapolation far outside the data.
mean_logMass <- mean(dat$logMass)
# MCMCglmm
l_mcmcglmm <- pool_chains(mcmcglmm_T1_2, "Sol")[, "(Intercept)"] + pool_chains(mcmcglmm_T1_2, "Sol")[, "logMass"] * mean_logMass
probabilities_mcmcglmm <- calculate_probabilities(0, pool_chains(mcmcglmm_T1_2, "CP")[, 1], l_mcmcglmm)
posterior_summary(probabilities_mcmcglmm)
#> Estimate Est.Error Q2.5 Q97.5
#> sedentary 0.3758873 0.18063839 0.04594959 0.7957818
#> partially_migratory 0.3397463 0.07994925 0.14404028 0.4874953
#> migratory 0.2843664 0.16348271 0.02219209 0.7091940
# brms
draws <- as_draws_df(brms_OT1_2)
probabilities_brms <- calculate_probabilities(draws$`b_Intercept[1]`, draws$`b_Intercept[2]`,
draws$b_logMass * mean_logMass)
posterior_summary(probabilities_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> sedentary 0.3711340 0.16375446 0.06317060 0.7472438
#> partially_migratory 0.3433715 0.07069778 0.18474606 0.4796120
#> migratory 0.2854944 0.14929631 0.03698734 0.6550769For a species of average body mass, the probabilities (MCMCglmm: 0.38, 0.34 and 0.28; brms: 0.37, 0.34 and 0.29 for sedentary, partially migratory and migratory) are very similar to those from the intercept-only model, which is consistent with a slope close to zero. Note that the probabilities have to be calculated from the thresholds and the linear predictor evaluated at a chosen predictor value: plugging in the intercept alone would correspond to logMass = 0, far outside the range of the data.
One continuous and one categorical explanatory variable model
The MCMCglmm model is as follows. Here, we use gelman.prior() to specify the prior covariance matrix of the fixed effects. It constructs the weakly informative prior recommended by Gelman et al. (2008), scaled so that it is approximately flat on the probability scale given the latent residual variance (set through scale; see Section 4). Such a prior regularises the fixed effects when the data contain little information about them (e.g. under near-separation) and can make sampling more stable, but it does not guarantee convergence.
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior1 <- list(B = list(mu = rep(0,4),
V = gelman.prior(~logMass + Habitat.Density, data = dat, scale = sqrt(1+1))),
R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)))
system.time(
mcmcglmm_T1_3 <- run_mcmcglmm_chains(Migration_ordered ~ logMass + Habitat.Density,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "threshold",
data = dat,
prior = prior1,
seeds = c(20264926, 20264927, 20264928, 20264929), # one seed per chain (four chains)
nitt = 13000*60,
thin = 10*60,
burnin = 3000*60
)
)
system.time(
mcmcglmm_O1_3 <- run_mcmcglmm_chains(Migration_ordered ~ logMass + Habitat.Density,
random = ~ Phylo,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "ordinal",
data = dat,
prior = prior1,
seeds = c(20265026, 20265027, 20265028, 20265029), # one seed per chain (four chains)
nitt = 13000*150,
thin = 10*150,
burnin = 3000*150
)
)For brms,
A <- ape::vcv.phylo(tree, corr = TRUE)
default_priors3 <- default_prior(
Migration_ordered ~ logMass + Habitat.Density + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
system.time(
brms_OT1_3 <- brm(
formula = Migration_ordered ~ logMass + Habitat.Density + (1 | gr(Phylo, cov = A)),
data = dat,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors3,
iter = 20000,
warmup = 10000,
thin = 1,
chains = 4,
cores = 4,
seed = 20272726,
control = list(adapt_delta = 0.999)
)
)# MCMCglmm
summarise_chains(mcmcglmm_T1_3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 1.1610 1.0140 -0.870300 3.1800 1.001 3675 3887
#> 2 logMass -0.2324 0.1345 -0.503200 0.0240 1.001 3558 3932
#> 3 Habitat.Densityopen 1.1560 0.3447 0.534400 1.8830 1.000 3928 3877
#> 4 Habitat.Densitysemi-open 0.3179 0.2898 -0.227600 0.9148 1.000 4093 3976
#> 5 Phylo 1.1160 1.7900 0.004338 4.6970 1.000 4037 4100
#> 6 units 1.0000 0.0000 1.000000 1.0000 NA NA NA
#> 7 cutpoint.traitMigration_ordered.1 1.0640 0.1803 0.771000 1.4610 1.001 4174 3827
posterior_summary(pool_chains(mcmcglmm_T1_3, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.115626 1.790052 0.004337597 4.697408
#> units 1.000000 0.000000 1.000000000 1.000000
posterior_summary(pool_chains(mcmcglmm_T1_3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 1.1608052 1.0144979 -0.8703382 3.17981821
#> logMass -0.2324211 0.1345127 -0.5032255 0.02399722
#> Habitat.Densityopen 1.1557006 0.3447066 0.5343777 1.88302297
#> Habitat.Densitysemi-open 0.3179227 0.2897567 -0.2275658 0.91480935
posterior_summary(pool_chains(mcmcglmm_T1_3, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 1.063591 0.1802779 0.7710347 1.461318
summarise_chains(mcmcglmm_O1_3) # pooled draws of four chains; 95% equal-tailed intervals
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 1.5590 1.3130 -1.050000 4.20300 1.000 4103 3904
#> 2 logMass -0.3012 0.1739 -0.655400 0.03802 1.000 4194 3822
#> 3 Habitat.Densityopen 1.5100 0.4501 0.671700 2.44500 1.000 3868 3849
#> 4 Habitat.Densitysemi-open 0.3873 0.3961 -0.395700 1.17600 1.001 4210 3852
#> 5 Phylo 1.6430 2.1780 0.006435 7.34100 1.001 3961 3914
#> 6 units 1.0000 0.0000 1.000000 1.00000 NA NA NA
#> 7 cutpoint.traitMigration_ordered.1 1.4650 0.2317 1.071000 2.00700 1.001 4052 3973
posterior_summary(pool_chains(mcmcglmm_O1_3, "VCV")) # 95% CI
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 1.643271 2.177759 0.006434844 7.340953
#> units 1.000000 0.000000 1.000000000 1.000000
posterior_summary(pool_chains(mcmcglmm_O1_3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 1.5592094 1.3126355 -1.0495310 4.2034257
#> logMass -0.3012380 0.1738655 -0.6554180 0.0380167
#> Habitat.Densityopen 1.5099793 0.4501488 0.6717383 2.4445734
#> Habitat.Densitysemi-open 0.3873436 0.3961165 -0.3956748 1.1762203
c2 <- 1
res_1 <- pool_chains(mcmcglmm_O1_3, "Sol") / sqrt(1+c2) # for fixed effects
res_2 <- pool_chains(mcmcglmm_O1_3, "VCV") / (1+c2) # for variance components
res_3 <- pool_chains(mcmcglmm_O1_3, "CP") / sqrt(1+c2)
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 1.1025275 0.9281735 -0.7421305 2.97227079
#> logMass -0.2130074 0.1229415 -0.4634505 0.02688186
#> Habitat.Densityopen 1.0677166 0.3183032 0.4749907 1.72857442
#> Habitat.Densitysemi-open 0.2738933 0.2800966 -0.2797843 0.83171336
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> Phylo 0.8216356 1.088879 0.003217422 3.670476
#> units 0.5000000 0.000000 0.500000000 0.500000
posterior_summary(res_3)
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitMigration_ordered.1 1.03606 0.1638556 0.7573277 1.41949
# brms
summary(brms_OT1_3)
#> Family: cumulative
#> Links: mu = probit
#> Formula: Migration_ordered ~ logMass + Habitat.Density + (1 | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 136)
#> Draws: 4 chains, each with iter = 20000; warmup = 10000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 136)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.92 0.56 0.08 2.24 1.00 3404 6772
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -1.34 1.08 -3.60 0.74 1.00 19581 15738
#> Intercept[2] -0.27 1.06 -2.41 1.84 1.00 21093 18645
#> logMass -0.26 0.14 -0.56 0.01 1.00 19501 16938
#> Habitat.Densityopen 1.24 0.37 0.57 2.03 1.00 10758 13795
#> Habitat.DensitysemiMopen 0.36 0.30 -0.21 0.98 1.00 23357 21646
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Species living in open habitats have higher migration levels than those living in dense habitats: Habitat.Densityopen is 1.16 (95% CI 0.53, 1.88) in the MCMCglmm threshold model and 1.24 (0.57, 2.03) in brms, and both intervals exclude zero. The difference between semi-open and dense habitats is smaller, and its intervals include zero (0.32 [−0.23, 0.91] and 0.36 [−0.21, 0.98]). The slope of logMass is negative (−0.23 [−0.50, 0.02] and −0.26 [−0.56, 0.01]), but its intervals narrowly include zero, so there is at most weak evidence that heavier species are less migratory after accounting for habitat density. The MCMCglmm ordinal model gives very similar estimates after the correction.
Below, we calculate the probabilities of each migration category for species of average body mass (mean logMass) living in each habitat type.
mean_logMass <- mean(dat$logMass)
# MCMCglmm: linear predictor for each habitat (dense is the reference level)
Sol <- pool_chains(mcmcglmm_T1_3, "Sol")
l_dense <- Sol[, "(Intercept)"] + Sol[, "logMass"] * mean_logMass
l_mcmcglmm <- list(dense = l_dense,
`semi-open` = l_dense + Sol[, "Habitat.Densitysemi-open"],
open = l_dense + Sol[, "Habitat.Densityopen"])
# posterior mean probability of each migration category (rows) in each habitat (columns)
sapply(l_mcmcglmm, function(l) colMeans(calculate_probabilities(0, pool_chains(mcmcglmm_T1_3, "CP")[, 1], l)))
#> dense semi-open open
#> sedentary 0.6263582 0.5164413 0.2381862
#> partially_migratory 0.2690477 0.3199206 0.3577025
#> migratory 0.1045942 0.1636382 0.4041112
# brms
draws <- as_draws_df(brms_OT1_3)
l_dense <- draws$b_logMass * mean_logMass
l_brms <- list(dense = l_dense,
`semi-open` = l_dense + draws$b_Habitat.DensitysemiMopen,
open = l_dense + draws$b_Habitat.Densityopen)
sapply(l_brms, function(l) colMeans(calculate_probabilities(draws$`b_Intercept[1]`, draws$`b_Intercept[2]`, l)))
#> dense semi-open open
#> sedentary 0.6188009 0.4936859 0.2144837
#> partially_migratory 0.2734490 0.3287402 0.3496559
#> migratory 0.1077501 0.1775739 0.4358604For a species of average body mass, the probability of being sedentary decreases and the probability of being migratory increases from dense to open habitats. In MCMCglmm, P(sedentary) is 0.63 in dense, 0.52 in semi-open and 0.24 in open habitats, and P(migratory) is 0.10, 0.16 and 0.40. brms gives similar values (0.62, 0.49 and 0.21; 0.11, 0.18 and 0.44).
Example 2
The second example is a cautionary example about identification and prior sensitivity. The response variable is Habitat.Density of the Phasianidae (179 species), with the ordered categories dense < semi-open < open, and the explanatory variables are the centred log tail length (cTail_length) and herbivory (IsHerbivore, 1 = at least 70% of food from plants). Almost all of the variation in habitat density in this family is phylogenetically structured, and we will see that this makes the latent scale of the threshold model hard to identify.
Dataset for example 2
dat <- read.csv(here("data", "bird body mass", "9993spp_clearned.csv"))
phasianidae_dat <- dat %>%
filter(Family == "Phasianidae") %>%
mutate(
# set the order of the categories explicitly (the default would be alphabetical)
Habitat.Density = factor(case_when(Habitat.Density == 1 ~ "dense",
Habitat.Density == 2 ~ "semi-open",
Habitat.Density == 3 ~ "open"),
levels = c("dense", "semi-open", "open"), ordered = TRUE),
# one species (Lophura hatinhensis) has no trophic level and is coded as non-herbivore
IsHerbivore = ifelse(Trophic.Level %in% "Herbivore", 1, 0)
)
phasianidae_dat$cTail_length <- as.numeric(scale(log(phasianidae_dat$Tail.Length), center = TRUE, scale = FALSE))
phasianidae_tree <- read.nexus(here("data", "bird body mass", "Phasianidae.nex"))[[1]]Models and prior specifications
We fit the intercept-only model, the model with tail length, and the model with tail length and herbivory, first with the same prior as in Example 1: a parameter-expanded prior that corresponds to a half-Cauchy prior with scale \(\sqrt{10}\) on the phylogenetic standard deviation. To check the sensitivity to this choice, we vary the scale within the same prior family (half-Cauchy scales 1 and 5). As an additional check of the prior family, we also use a scaled \(\chi^2_1\) prior on the phylogenetic variance, which is much more regularising.
inv_phylo2 <- inverseA(phasianidae_tree, nodes = "ALL", scale = TRUE)
# half-Cauchy(0, s) prior on the phylogenetic SD (parameter expansion with alpha.V = s^2)
prior_hc <- function(s) list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = s^2)))
# scaled chi-square (1 df) prior on the phylogenetic variance: a more regularising prior family
prior_chisq <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1000, alpha.mu = 0, alpha.V = 1)))
formulas2 <- list(Habitat.Density ~ 1,
Habitat.Density ~ cTail_length,
Habitat.Density ~ cTail_length + IsHerbivore)
# four chains of one model; k multiplies the default nitt, thin and burnin
fit_ex2 <- function(formula, prior, seeds, k, family = "threshold") {
run_mcmcglmm_chains(formula, random = ~ Phylo, ginverse = list(Phylo = inv_phylo2$Ainv),
family = family, data = phasianidae_dat, prior = prior, seeds = seeds,
nitt = 13000*k, thin = 10*k, burnin = 3000*k)
}
# main specification: half-Cauchy(0, sqrt(10)), threshold and ordinal families
mcmcglmm_T2_1 <- fit_ex2(formulas2[[1]], prior_hc(sqrt(10)), c(20261026, 20261027, 20261028, 20261029), k = 65)
mcmcglmm_T2_2 <- fit_ex2(formulas2[[2]], prior_hc(sqrt(10)), c(20261126, 20261127, 20261128, 20261129), k = 600)
mcmcglmm_T2_3 <- fit_ex2(formulas2[[3]], prior_hc(sqrt(10)), c(20261226, 20261227, 20261228, 20261229), k = 600)
mcmcglmm_O2_1 <- fit_ex2(formulas2[[1]], prior_hc(sqrt(10)), c(20261326, 20261327, 20261328, 20261329), k = 500, family = "ordinal")
mcmcglmm_O2_2 <- fit_ex2(formulas2[[2]], prior_hc(sqrt(10)), c(20261426, 20261427, 20261428, 20261429), k = 600, family = "ordinal")
mcmcglmm_O2_3 <- fit_ex2(formulas2[[3]], prior_hc(sqrt(10)), c(20261526, 20261527, 20261528, 20261529), k = 600, family = "ordinal")
# prior sensitivity (threshold family): half-Cauchy scales 1 and 5, and the chi-square prior
mcmcglmm_T2_1_hc1 <- fit_ex2(formulas2[[1]], prior_hc(1), c(20265626, 20265627, 20265628, 20265629), k = 65)
mcmcglmm_T2_2_hc1 <- fit_ex2(formulas2[[2]], prior_hc(1), c(20265726, 20265727, 20265728, 20265729), k = 600)
mcmcglmm_T2_3_hc1 <- fit_ex2(formulas2[[3]], prior_hc(1), c(20265826, 20265827, 20265828, 20265829), k = 600)
mcmcglmm_T2_1_hc5 <- fit_ex2(formulas2[[1]], prior_hc(5), c(20265926, 20265927, 20265928, 20265929), k = 65)
mcmcglmm_T2_2_hc5 <- fit_ex2(formulas2[[2]], prior_hc(5), c(20266026, 20266027, 20266028, 20266029), k = 600)
mcmcglmm_T2_3_hc5 <- fit_ex2(formulas2[[3]], prior_hc(5), c(20266126, 20266127, 20266128, 20266129), k = 600)
mcmcglmm_T2_1_chisq <- fit_ex2(formulas2[[1]], prior_chisq, c(20268926, 20268927, 20268928, 20268929), k = 65)
mcmcglmm_T2_2_chisq <- fit_ex2(formulas2[[2]], prior_chisq, c(20269026, 20269027, 20269028, 20269029), k = 600)
mcmcglmm_T2_3_chisq <- fit_ex2(formulas2[[3]], prior_chisq, c(20269126, 20269127, 20269128, 20269129), k = 600)In brms, the default prior on the phylogenetic SD is a Student-t(3, 0, 2.5) distribution. We use it as the main specification and vary its scale (1 and 5) for the sensitivity analysis.
A <- ape::vcv.phylo(phasianidae_tree, corr = TRUE)
brms_formulas2 <- list(Habitat.Density ~ 1 + (1 | gr(Phylo, cov = A)),
Habitat.Density ~ cTail_length + (1 | gr(Phylo, cov = A)),
Habitat.Density ~ cTail_length + IsHerbivore + (1 | gr(Phylo, cov = A)))
iter2 <- c(6000, 10000, 8000); warmup2 <- c(4000, 8000, 6000); adapt2 <- c(0.95, 0.99, 0.999) # model 3: 0.999 (at 0.95, a few divergent transitions)
# model i with a Student-t(3, 0, s) prior on the phylogenetic SD (s = 2.5 is the default)
fit_ex2_brms <- function(i, s, seed) {
pri <- default_prior(brms_formulas2[[i]], data = phasianidae_dat, data2 = list(A = A),
family = cumulative(link = "probit"))
pri$prior[pri$class == "sd" & pri$coef == "" & pri$group == ""] <- sprintf("student_t(3, 0, %s)", s)
brm(brms_formulas2[[i]], data = phasianidae_dat, data2 = list(A = A),
family = cumulative(link = "probit"), prior = pri,
iter = iter2[i], warmup = warmup2[i], thin = 1, chains = 4, cores = 4, seed = seed,
control = list(adapt_delta = adapt2[i]))
}
brms_OT2_1 <- fit_ex2_brms(1, 2.5, seed = 20261626)
brms_OT2_2 <- fit_ex2_brms(2, 2.5, seed = 20261726)
brms_OT2_3 <- fit_ex2_brms(3, 2.5, seed = 20273026)
brms_OT2_1_sd1 <- fit_ex2_brms(1, 1, seed = 20266226)
brms_OT2_2_sd1 <- fit_ex2_brms(2, 1, seed = 20266326)
brms_OT2_3_sd1 <- fit_ex2_brms(3, 1, seed = 20273126)
brms_OT2_1_sd5 <- fit_ex2_brms(1, 5, seed = 20266526)
brms_OT2_2_sd5 <- fit_ex2_brms(2, 5, seed = 20266626)
brms_OT2_3_sd5 <- fit_ex2_brms(3, 5, seed = 20273226)The half-Cauchy specifications do not identify the latent scale
First, we check the between-chain diagnostics of the MCMCglmm fits. For each prior and model, we show the largest Rhat, the smallest bulk ESS, and the median of the phylogenetic variance in each of the four chains.
diag_ex2 <- function(fits) {
s <- summarise_chains(fits); s <- s[s$sd > 0, ]
data.frame(max_rhat = round(max(s$rhat), 2), min_ess_bulk = round(min(s$ess_bulk)),
phylo_var_median_per_chain = paste(signif(sapply(fits, function(m) median(m$VCV[, "Phylo"])), 2),
collapse = " / "))
}
ex2_fits <- list(
"half-Cauchy(0, 1)" = list(mcmcglmm_T2_1_hc1, mcmcglmm_T2_2_hc1, mcmcglmm_T2_3_hc1),
"half-Cauchy(0, sqrt(10))" = list(mcmcglmm_T2_1, mcmcglmm_T2_2, mcmcglmm_T2_3),
"half-Cauchy(0, 5)" = list(mcmcglmm_T2_1_hc5, mcmcglmm_T2_2_hc5, mcmcglmm_T2_3_hc5),
"ordinal family, half-Cauchy(0, sqrt(10))" = list(mcmcglmm_O2_1, mcmcglmm_O2_2, mcmcglmm_O2_3),
"chi-square(1)" = list(mcmcglmm_T2_1_chisq, mcmcglmm_T2_2_chisq, mcmcglmm_T2_3_chisq))
do.call(rbind, lapply(names(ex2_fits), function(p)
cbind(prior = p, model = 1:3, do.call(rbind, lapply(ex2_fits[[p]], diag_ex2)))))
#> prior model max_rhat min_ess_bulk phylo_var_median_per_chain
#> 1 half-Cauchy(0, 1) 1 1.57 7 29 / 46 / 3700 / 25
#> 2 half-Cauchy(0, 1) 2 1.71 6 150000 / 98000 / 38000 / 130000
#> 3 half-Cauchy(0, 1) 3 2.40 5 82000 / 460000 / 19000 / 130000
#> 4 half-Cauchy(0, sqrt(10)) 1 1.04 199 48 / 29 / 32 / 35
#> 5 half-Cauchy(0, sqrt(10)) 2 1.72 6 71000 / 20000 / 86000 / 62000
#> 6 half-Cauchy(0, sqrt(10)) 3 2.58 5 72000 / 290000 / 350000 / 14000
#> 7 half-Cauchy(0, 5) 1 2.32 5 19000 / 6800 / 810 / 740
#> 8 half-Cauchy(0, 5) 2 1.63 7 47000 / 40000 / 32000 / 15000
#> 9 half-Cauchy(0, 5) 3 1.73 6 62000 / 180000 / 68000 / 210000
#> 10 ordinal family, half-Cauchy(0, sqrt(10)) 1 1.10 33 90 / 210 / 67 / 56
#> 11 ordinal family, half-Cauchy(0, sqrt(10)) 2 1.69 6 250000 / 7900 / 2500 / 10000
#> 12 ordinal family, half-Cauchy(0, sqrt(10)) 3 1.44 8 87000 / 61000 / 150000 / 53000
#> 13 chi-square(1) 1 1.00 3980 6.7 / 7 / 6.6 / 6.6
#> 14 chi-square(1) 2 1.00 3932 6.6 / 6.7 / 6.5 / 6.7
#> 15 chi-square(1) 3 1.00 3774 7 / 7.1 / 7.1 / 7The trace plots of the phylogenetic variance make the problem visible: with the half-Cauchy prior, the four chains drift to different, extremely large values.
plot(chains_list(mcmcglmm_T2_3, "VCV")[, "Phylo"], main = "Phylogenetic variance, half-Cauchy(0, sqrt(10))")
plot(chains_list(mcmcglmm_T2_3_chisq, "VCV")[, "Phylo"], main = "Phylogenetic variance, chi-square(1)")
With all three half-Cauchy scales, the MCMCglmm fits do not converge. For eight of the nine fits, R-hat is far above 1.01 (1.6–2.6) and the bulk ESS is below 10; the ordinal family behaves in the same way. The per-chain medians of the phylogenetic variance show why: the four chains drift to widely different values, most of them in the thousands or more on a latent scale whose residual variance is 1. Only the intercept-only model with scale \(\sqrt{10}\) comes close to convergence (R-hat 1.04), and even there the phylogenetic variance is about 30–50.
The reason is that almost all of the variation in habitat density is shared among closely related species. When the phylogenetic variance is very large relative to the residual variance (fixed at 1), the likelihood is almost flat along the overall scale of the latent variable: multiplying the phylogenetic effects, the fixed effects and the cutpoint by a common factor hardly changes the predicted categories. The heavy-tailed half-Cauchy prior does not prevent the chains from drifting along this direction, so the raw latent-scale quantities (the phylogenetic variance, the fixed effects and the cutpoint) are not identified by these fits, and longer chains would not solve the problem. We therefore do not interpret the half-Cauchy fits.
With the scaled \(\chi^2_1\) prior, which puts much less mass on very large variances, the chains converge (R-hat 1.00, bulk ESS > 3,700) and the phylogenetic variance is about 7. This is a check of the prior family, not a “fix”: the \(\chi^2_1\) prior makes the latent scale identifiable by regularising it, and the magnitudes of the estimates depend on this choice.
The identified fits: MCMCglmm with the chi-square prior and brms
brms_diag <- function(fit) {
s <- posterior::summarise_draws(fit, "rhat", "ess_bulk")
s <- s[grepl("^(b_|sd_)", s$variable), ]
np <- nuts_params(fit)
data.frame(max_rhat = round(max(s$rhat), 3), min_ess_bulk = round(min(s$ess_bulk)),
divergent = sum(np$Value[np$Parameter == "divergent__"]))
}
ex2_brms <- list("Student-t(3, 0, 1)" = list(brms_OT2_1_sd1, brms_OT2_2_sd1, brms_OT2_3_sd1),
"Student-t(3, 0, 2.5)" = list(brms_OT2_1, brms_OT2_2, brms_OT2_3),
"Student-t(3, 0, 5)" = list(brms_OT2_1_sd5, brms_OT2_2_sd5, brms_OT2_3_sd5))
do.call(rbind, lapply(names(ex2_brms), function(p)
cbind(sd_prior = p, model = 1:3, do.call(rbind, lapply(ex2_brms[[p]], brms_diag)))))
#> sd_prior model max_rhat min_ess_bulk divergent
#> 1 Student-t(3, 0, 1) 1 1.002 1093 0
#> 2 Student-t(3, 0, 1) 2 1.002 1053 0
#> 3 Student-t(3, 0, 1) 3 1.006 673 0
#> 4 Student-t(3, 0, 2.5) 1 1.001 975 0
#> 5 Student-t(3, 0, 2.5) 2 1.002 785 0
#> 6 Student-t(3, 0, 2.5) 3 1.009 626 0
#> 7 Student-t(3, 0, 5) 1 1.005 967 0
#> 8 Student-t(3, 0, 5) 2 1.003 882 0
#> 9 Student-t(3, 0, 5) 3 1.003 724 0Across all identified fits, we compare the proportion of the latent-scale variance attributed to phylogeny (intercept-only model; residual variance 1 for the probit link) and the effects of tail length and herbivory (full model). All quantities are calculated for each posterior draw.
q <- function(x) sprintf("%.2f (%.2f, %.2f)", mean(x), quantile(x, 0.025), quantile(x, 0.975))
ex2_mcmc_row <- function(f1, f3) {
v <- pool_chains(f1, "VCV")[, "Phylo"]; S <- pool_chains(f3, "Sol")
c(H2 = q(v / (v + 1)), tail_length = q(S[, "cTail_length"]), herbivore = q(S[, "IsHerbivore"]),
P_herbivore_positive = sprintf("%.2f", mean(S[, "IsHerbivore"] > 0)))
}
ex2_brms_row <- function(f1, f3) {
d1 <- as_draws_df(f1); d3 <- as_draws_df(f3); v <- d1$sd_Phylo__Intercept^2
c(H2 = q(v / (v + 1)), tail_length = q(d3$b_cTail_length), herbivore = q(d3$b_IsHerbivore),
P_herbivore_positive = sprintf("%.2f", mean(d3$b_IsHerbivore > 0)))
}
rbind("MCMCglmm, chi-square(1)" = ex2_mcmc_row(mcmcglmm_T2_1_chisq, mcmcglmm_T2_3_chisq),
"brms, Student-t(3, 0, 1)" = ex2_brms_row(brms_OT2_1_sd1, brms_OT2_3_sd1),
"brms, Student-t(3, 0, 2.5)" = ex2_brms_row(brms_OT2_1, brms_OT2_3),
"brms, Student-t(3, 0, 5)" = ex2_brms_row(brms_OT2_1_sd5, brms_OT2_3_sd5))
#> H2 tail_length herbivore P_herbivore_positive
#> MCMCglmm, chi-square(1) "0.86 (0.76, 0.93)" "-0.39 (-1.22, 0.44)" "-0.10 (-0.99, 0.73)" "0.42"
#> brms, Student-t(3, 0, 1) "0.91 (0.80, 0.98)" "-0.32 (-1.75, 1.28)" "-0.57 (-2.74, 0.68)" "0.24"
#> brms, Student-t(3, 0, 2.5) "0.93 (0.84, 0.99)" "-0.35 (-2.01, 1.42)" "-0.74 (-3.16, 0.72)" "0.20"
#> brms, Student-t(3, 0, 5) "0.95 (0.86, 0.99)" "-0.27 (-2.53, 2.29)" "-1.19 (-4.61, 0.61)" "0.14" All brms fits are identified. With each of the three prior scales, R-hat is at most 1.01, the bulk ESS is above 600, and there are no divergent transitions (for the full model we used adapt_delta = 0.999, because a few divergent transitions occurred at 0.95). The Student-t prior used by brms has lighter tails than the half-Cauchy prior, which is enough to keep the latent scale in a plausible region.
Across the identified fits, the qualitative conclusion is similar. Almost all of the latent-scale variation in habitat density is attributed to phylogeny (0.86 with the \(\chi^2_1\) prior in MCMCglmm and 0.91–0.95 in brms), and neither tail length nor herbivory has a clear effect: all 95% CIs include zero. The magnitudes, however, depend on the prior. The larger the prior scale of the phylogenetic SD, the larger the estimated phylogenetic variance and the larger (in absolute value) and more uncertain the fixed effects. For example, the herbivory effect ranges from −0.10 (95% CI −0.99, 0.73) with the \(\chi^2_1\) prior to −1.19 (−4.61, 0.61) with the Student-t(3, 0, 5) prior. This is expected, because the fixed effects are expressed in units of the latent residual SD, and the data determine the overall scale of the latent variable only weakly.
4. Nominal models
When the response variable has more than two unordered categories, it is treated as a nominal variable.
Prior setting
Obtaining well-mixing chains can be challenging, particularly for discrete (and especially nominal) models. In such cases, replacing the default prior with a carefully chosen custom prior (i.e. an appropriately regularising prior, not an overly informative one) can stabilise the estimation. Whether this helps, and how much it changes the results, depends on the scale of the parameters, how much information the data contain about them, (quasi-)separation and the model structure, so its effect should always be checked.
Fixed Effects
When the data contain plenty of information about the fixed effects, the prior on them has little influence on the results. This is often, but not always, the case in discrete models: with few observations per category or (quasi-)complete separation, flat or very wide priors on the fixed effects can lead to extreme estimates and poor mixing, and weakly informative (regularising) priors are then appropriate. Priors on fixed effects are also useful when you know biological limits (e.g. some values of bird morphology are not realistic). In MCMCglmm, the gelman.prior() function is particularly useful for logit and probit models. It constructs the prior covariance matrix for the fixed effects recommended by Gelman et al. (2008). Specifically…
- For logit regression, where the variance of the latent error distribution is \(\pi^2/3\) (plus the
unitsvariance inMCMCglmm), thescaleargument is set so that the prior is approximately flat on the probability scale. - For probit regression, where the variance of the latent error distribution is 1 (plus the
unitsvariance forfamily = "ordinal"), the scale is adjusted accordingly.
gelman.prior() thus provides weakly informative priors on the fixed effects that regularise extreme values without dominating the information in the data, as recommended by Gelman et al. (2008).
Random effects
Mixing problems often arise with random effects, because variance components are harder to estimate than fixed effects: they describe the variability around the mean, which requires more data to estimate precisely, and their posterior distributions are often skewed and bounded at zero. In contrast, fixed effects describe means (e.g. the overall mean in an intercept-only model) and usually stabilise with less data. More informative priors on the variance components can help in such cases, but they change what the posterior represents, so the benefit for sampling has to be weighed against their influence on the estimates that you interpret.
Key points
Check autocorrelation: An autocorrelation plot helps assess the mixing of the chain. It shows the relationship between current and past samples in the MCMC chain. High autocorrelation (i.e. slow decay) indicates poor mixing because the chain is highly correlated across iterations, meaning that it is not exploring the parameter space efficiently. Ideally, the autocorrelation should drop to near zero quickly, indicating that the chain is moving smoothly and independently across the parameter space. - Lag (X-axis): The interval between the current and past samples. - Autocorrelation coefficient (Y-axis): Indicates the strength of the correlation, ranging from -1 to 1. A value close to 0 (excluding lag 0) is ideal.
In the context of MCMC, it would be important to differentiate between convergence and mixing, as these two terms are often conflated, but they refer to distinct aspects of the MCMC process. Convergence refers to whether the Markov chains have reached the target posterior distribution. For MCMC to be valid, the chains should eventually explore the entire parameter space of the target distribution. In many cases, this is evaluated by running multiple chains from dispersed starting points and checking whether they all sample the same distribution (e.g. Rhat in brms). An Rhat value close to 1.0 indicates no evidence of non-convergence; it cannot prove convergence.
Mixing refers to how well the Markov chain explores the parameter space during the sampling process. Good mixing means that the chain moves smoothly across the parameter space, avoiding long periods of stagnation in any particular region. Poor mixing can result in the chain getting stuck in one area of the parameter space and not exploring others effectively.
In MCMCglmm, one call to MCMCglmm() runs a single chain. To check convergence with multiple chains, run the same model several times with different random seeds and compare the chains with coda::gelman.diag() or posterior::rhat(). We do this for every MCMCglmm model in this tutorial with run_mcmcglmm_chains() (see Note 4). Autocorrelation plots and effective sample sizes of a single chain give additional insight into the quality of the sampling.
Practical benefits of informative priors for random effects
Informative priors for random effects can regularise weakly identified variance components and sometimes improve mixing and shorten the required run length, because they restrict the sampler to a smaller region of the parameter space. This is not guaranteed, and poorly chosen priors can distort inference. Such priors change the point estimates (often) and the uncertainty (always) of the random effects (i.e. variances and covariances). Their impact on the fixed-effect estimates is often smaller, but it should be checked, because the random-effect variances determine the scale of the latent variable in discrete models. If your primary interest lies in the fixed effects, you can use this approach, but report the prior and check the sensitivity of your conclusions to it.
Potential problems with informative priors
Over-constrained parameters: Excessively narrow priors can provide us with incorrect parameter estimates by limiting them to a small range.
Small sample size issues: When sample sizes are small, informative priors may dominate the posterior distribution, overshadowing the data. This can lead to the model failing to capture the variability in the data and to an oversimplified representation of the data-generating process.
There is no general rule that “uninformative” priors are needed to estimate random effects properly, and truly uninformative priors for variance components do not exist: every prior has some influence when the data are weakly informative. A practical approach is to use weakly informative priors (e.g. parameter-expanded priors in MCMCglmm), check the sensitivity of the results to the prior, and follow a diagnostic workflow when the chains mix slowly:
- run longer chains (more iterations after burn-in), which increases the number of effective posterior samples if the chains are sampling correctly
- check that the burn-in (
MCMCglmm) / warm-up (brms) is long enough to remove the initial transient; a longer burn-in alone does not guarantee convergence - run several independent chains and compare them (R-hat), together with trace plots, autocorrelation and effective sample sizes
- increase thinning in
MCMCglmmif needed to reduce storage requirements or autocorrelation among retained samples, although thinning itself does not improve convergence
Examples Here is an example of a weakly informative vs an informative prior…
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
# weakly informative (parameter-expanded) prior
prior1 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 2,
alpha.mu = rep(0, 2), alpha.V = diag(2)
)
)
)
system.time(
mcmcglmm_m1_100 <- MCMCglmm(Primary.Lifestyle ~ trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior1,
nitt = 13000*100,
thin = 10*100,
burnin = 3000*100
)
)
system.time(
mcmcglmm_m1_1000 <- MCMCglmm(Primary.Lifestyle ~ trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior1,
nitt = 13000*1000,
thin = 10*1000,
burnin = 3000*1000
)
)
# informative prior
prior2 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 200,
alpha.mu = rep(0, 2), alpha.V = diag(2)
)
)
)
system.time(
mcmcglmm_m2 <- MCMCglmm(Primary.Lifestyle ~ trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior2,
nitt = 13000*75,
thin = 10*75,
burnin = 3000*75
)
)These three fits are single-chain illustrations of the effect of chain length and prior; they are not part of the analyses that we interpret, so we show their summary() output directly. With the weakly informative prior, the short run (mcmcglmm_m1_100) has very small effective sample sizes for the variance components (about 30–40 out of 1,000 stored samples). Running the chain 10 times longer (mcmcglmm_m1_1000) increases the effective sample sizes (about 90–270), although the phylogenetic variances still mix slowly. With the informative prior (mcmcglmm_m2, nu = 200), the chain mixes well, but the variance estimates are pulled strongly towards the prior (compare the posterior means). Better mixing obtained through the prior is therefore not free: it changes the estimates.
summary(mcmcglmm_m1_100)
#>
#> Iterations = 300001:1299001
#> Thinning interval = 1000
#> Sample size = 1000
#>
#> DIC: 259.4007
#>
#> G-structure: ~us(trait):Phylo
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 31.18 1.252 83.25 37.85
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -12.08 -70.340 59.37 41.96
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -12.08 -70.340 59.37 41.96
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 104.23 1.118 408.78 28.75
#>
#> R-structure: ~us(trait):units
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.6667 0.6667 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.6667 0.6667 0
#>
#> Location effects: Primary.Lifestyle ~ trait - 1
#>
#> post.mean l-95% CI u-95% CI eff.samp pMCMC
#> traitPrimary.Lifestyle.Insessorial -1.628 -10.272 7.019 148.9 0.662
#> traitPrimary.Lifestyle.Terrestrial 5.279 -7.006 19.131 125.6 0.314
summary(mcmcglmm_m1_1000)
#>
#> Iterations = 3000001:12990001
#> Thinning interval = 10000
#> Sample size = 1000
#>
#> DIC: 273.7709
#>
#> G-structure: ~us(trait):Phylo
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 30.88 1.314 99.34 270.66
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -25.45 -94.475 29.87 218.26
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -25.45 -94.475 29.87 218.26
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 81.67 1.144 369.51 89.38
#>
#> R-structure: ~us(trait):units
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.6667 0.6667 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.6667 0.6667 0
#>
#> Location effects: Primary.Lifestyle ~ trait - 1
#>
#> post.mean l-95% CI u-95% CI eff.samp pMCMC
#> traitPrimary.Lifestyle.Insessorial -1.3033 -5.3581 2.3037 1000 0.478
#> traitPrimary.Lifestyle.Terrestrial 0.9187 -3.7341 5.2263 1000 0.676
summary(mcmcglmm_m2)
#>
#> Iterations = 225001:974251
#> Thinning interval = 750
#> Sample size = 1000
#>
#> DIC: 298.0892
#>
#> G-structure: ~us(trait):Phylo
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 6.0759 0.2940 12.1120 731.3
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -0.0885 -0.9723 0.9838 1000.0
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -0.0885 -0.9723 0.9838 1000.0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 6.8348 1.5880 13.6006 820.7
#>
#> R-structure: ~us(trait):units
#>
#> post.mean l-95% CI u-95% CI eff.samp
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.6667 0.6667 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.3333 0.3333 0
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.6667 0.6667 0
#>
#> Location effects: Primary.Lifestyle ~ trait - 1
#>
#> post.mean l-95% CI u-95% CI eff.samp pMCMC
#> traitPrimary.Lifestyle.Insessorial -0.3218 -3.7935 3.0988 1000.0 0.908
#> traitPrimary.Lifestyle.Terrestrial 2.2780 -1.3172 5.8322 888.4 0.180autocorr.plot(mcmcglmm_m1_100$VCV)
autocorr.plot(mcmcglmm_m1_1000$VCV)
autocorr.plot(mcmcglmm_m2$VCV)
Explanation of dataset
Dataset for example 1
This dataset focuses on thrushes (Turdidae; 173 species). The response variable is the primary lifestyle (Generalist, Insessorial or Terrestrial; Generalist is the reference category), and we create a binary variable IsOmnivore based on the trophic level.
trees <- read.nexus(here("data", "potential", "avonet", "trees.nex"))
tree <- trees[[1]]
dat <- read.csv(here("data", "potential", "avonet", "turdidae.csv"))
# Check tree$tip.label matches dat$Scientific_name
match_result <- setequal(tree$tip.label, dat$Phylo)
# Centering for continuous variables
dat <- dat %>%
mutate(
log_Mass_centered = scale(log(Mass), center = TRUE, scale = FALSE),
log_Tail_Length_centered = scale(log(Tail.Length), center = TRUE, scale = FALSE)
)
dat <- dat %>%
mutate(across(c(Trophic.Level, Trophic.Niche, Primary.Lifestyle, Migration, Habitat, Species.Status), as.factor))
dat$IsOmnivore <- ifelse(dat$Trophic.Level == "Omnivore", 1, 0)Example 1
Intercept-only model
MCMCglmm
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior5 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 20,
alpha.mu = rep(0, 2), alpha.V = diag(2)*(pi^2/3))
)
)
system.time(
mcmcglmm_mn1_1 <- run_mcmcglmm_chains(Primary.Lifestyle ~ trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior5,
seeds = c(20265126, 20265127, 20265128, 20265129), # one seed per chain (four chains)
nitt = 13000*100,
thin = 10*100,
burnin = 3000*100
)
)brms
A <- ape::vcv.phylo(tree, corr = TRUE)
# Weakly informative priors used for all three nominal brms models:
# half-normal(0, 2) on the phylogenetic SDs, Student-t(3, 0, 1) on the intercepts,
# LKJ(2) on the phylogenetic correlation, and Normal(0, 10) on the slopes (models 2 and 3).
# (With brms' default priors, the sampler produced divergent transitions for these models.)
nominal_priors <- function(slopes = character(0)) {
p <- c(prior(student_t(3, 0, 1), class = "Intercept", dpar = "muInsessorial"),
prior(student_t(3, 0, 1), class = "Intercept", dpar = "muTerrestrial"),
prior(normal(0, 2), class = "sd", group = "Phylo", dpar = "muInsessorial"),
prior(normal(0, 2), class = "sd", group = "Phylo", dpar = "muTerrestrial"),
prior(lkj(2), class = "cor", group = "Phylo"))
for (sl in slopes) for (dp in c("muInsessorial", "muTerrestrial"))
p <- c(p, set_prior("normal(0, 10)", class = "b", coef = sl, dpar = dp))
p
}
priors_brms1 <- nominal_priors()
system.time(
brms_mn1_1 <- brm(Primary.Lifestyle ~ 1 + (1 |a| gr(Phylo, cov = A)),
data = dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms1,
iter = 15000,
warmup = 10000,
chains = 4,
cores = 4,
seed = 20270526,
thin = 1
)
)As with the binary logit model in MCMCglmm, we rescale the estimates of the nominal model to remove the effect of the additive overdispersion (units) term, using the code below. For a nominal response with \(K\) categories and the residual covariance matrix fixed at \((\mathbf{I} + \mathbf{J})/K\), the residual variance of each of the \(K-1\) latent variables is \((K-1)/K\) (here \(2/3\)), so the constant becomes \(c^2 (K-1)/K\) (Hadfield, MCMCglmm course notes). Integrating over the residuals, the category probabilities are then approximately those of a standard multinomial logit (as fitted by brms) with location effects \(\beta/\sqrt{1 + c^2 (K-1)/K}\) and (co)variances \(\Sigma/(1 + c^2 (K-1)/K)\).
The residual covariance matrix is fixed by this parameterisation. The correlation between the residuals of the two contrasts (0.5, from the fixed matrix) is therefore not an estimated model result, and we do not report it.
c2 <- (16 * sqrt(3)/(15 * pi))^2
c2a <- (16 * sqrt(3)/(15 * pi))^2*(2/3)The results are…
summarise_chains(mcmcglmm_mn1_1)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitPrimary.Lifestyle.Insessorial -0.9318 2.865 -7.0620 4.2450 1.000 3536 3512
#> 2 traitPrimary.Lifestyle.Terrestrial 3.0440 2.808 -1.9320 9.4450 1.001 3333 3206
#> 3 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 15.9600 10.650 3.3580 43.3600 1.001 1904 2097
#> 4 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -1.2750 4.072 -9.7880 6.8650 1.000 3031 3159
#> 5 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -1.2750 4.072 -9.7880 6.8650 1.000 3031 3159
#> 6 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 17.4900 11.930 3.9910 48.2000 1.001 1777 1879
#> 7 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
#> 8 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 9 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 10 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn1_1, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn1_1, "VCV") / (1 + c2a) # (co)variances; the units (residual) rows are fixed, not estimated
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial -0.8399931 2.582816 -6.365688 3.826457
#> traitPrimary.Lifestyle.Terrestrial 2.7440926 2.531627 -1.741326 8.513926
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 12.9712860 8.652459 2.7288766 35.2387543
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -1.0362239 3.309313 -7.9543471 5.5788505
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -1.0362239 3.309313 -7.9543471 5.5788505
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 14.2120253 9.690745 3.2436397 39.1677224
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each posterior draw
# (a correlation is not changed by the c2 correction, so the raw (co)variances can be used)
VCV <- pool_chains(mcmcglmm_mn1_1, "VCV")
corr_phylo <- VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo"] /
sqrt(VCV[, "traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo"] * VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.09169124 0.2220161 -0.5066453 0.3467325
summary(brms_mn1_1)
#> Family: categorical
#> Links: muInsessorial = logit; muTerrestrial = logit
#> Formula: Primary.Lifestyle ~ 1 + (1 | a | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 173)
#> Draws: 4 chains, each with iter = 15000; warmup = 10000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 173)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muInsessorial_Intercept) 3.27 1.02 1.57 5.53 1.00 8105 11946
#> sd(muTerrestrial_Intercept) 3.57 1.08 1.77 5.96 1.00 7498 12068
#> cor(muInsessorial_Intercept,muTerrestrial_Intercept) -0.25 0.32 -0.80 0.40 1.00 3566 8096
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muInsessorial_Intercept -0.20 1.07 -2.50 1.86 1.00 21827 10668
#> muTerrestrial_Intercept 0.56 1.17 -1.45 3.15 1.00 22141 11093
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).After the c2 correction, the intercepts are very uncertain in both packages (Insessorial vs Generalist: −0.84, 95% CI −6.37, 3.83 in MCMCglmm and −0.20, −2.50, 1.86 in brms; Terrestrial vs Generalist: 2.74, −1.74, 8.51 and 0.56, −1.45, 3.15). The brms intervals are narrower, mainly because of its Student-t(3, 0, 1) prior on the intercepts. The phylogenetic variances are similar: the c2-corrected MCMCglmm variances are 13.0 and 14.2 (i.e. SDs of about 3.6 and 3.8), and the brms SDs are 3.27 and 3.57. The phylogenetic correlation between the two contrasts is weak and uncertain in both packages (−0.09, 95% CI −0.51, 0.35 in MCMCglmm; −0.25, −0.80, 0.40 in brms).
Phylogenetic variance proportions
For a nominal response, a single “phylogenetic signal” is not defined. Instead, we calculate a category-specific phylogenetic variance proportion on the latent scale of the reference-category multinomial logit. Each of the \(K-1\) linear predictors describes the log-odds of one category relative to the reference category (here, Generalist). In the random-utility representation of the multinomial logit, the latent residual of each such contrast is the difference between two standard Gumbel variables. This is a logistic variable with variance \(\pi^2/3\), and the residuals of two contrasts that share the reference category are correlated at 0.5. The proportion for contrast \(j\) is therefore
\[ H^2_j = \frac{\sigma^2_{\text{phylo},j}}{\sigma^2_{\text{phylo},j} + \pi^2/3}, \]
with the species-level variance added to the denominator when the model includes it. For MCMCglmm, we use the c2-corrected variances, which are on the scale of a standard multinomial logit (the same scale as brms). This quantity refers to a particular contrast and depends on the choice of reference category. It is neither an overall phylogenetic signal of the nominal trait nor Pagel’s \(\lambda\).
# Category-specific phylogenetic variance proportion on the latent scale of the
# reference-category multinomial logit (reference: Generalist):
# sigma2_phylo / (sigma2_phylo + pi^2/3), calculated for each posterior draw
## MCMCglmm: c2-corrected phylogenetic variances
var_Insessorial <- pool_chains(mcmcglmm_mn1_1, "VCV")[, "traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo"] / (1 + c2a)
var_Terrestrial <- pool_chains(mcmcglmm_mn1_1, "VCV")[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo"] / (1 + c2a)
posterior_summary(var_Insessorial / (var_Insessorial + pi^2 / 3)) # Insessorial vs Generalist
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.7463375 0.1204887 0.4533963 0.9146124
posterior_summary(var_Terrestrial / (var_Terrestrial + pi^2 / 3)) # Terrestrial vs Generalist
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.7620238 0.1122212 0.4964622 0.922514
## brms
draws <- as_draws_df(brms_mn1_1)
posterior_summary(with(draws, sd_Phylo__muInsessorial_Intercept^2 / (sd_Phylo__muInsessorial_Intercept^2 + pi^2 / 3)))
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.7303241 0.1238207 0.4273746 0.9028302
posterior_summary(with(draws, sd_Phylo__muTerrestrial_Intercept^2 / (sd_Phylo__muTerrestrial_Intercept^2 + pi^2 / 3)))
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.762588 0.1114635 0.4891413 0.9153566For the Insessorial vs Generalist contrast, the phylogenetic variance proportion is 0.75 (95% CI 0.45, 0.91) in MCMCglmm and 0.73 (0.43, 0.90) in brms. For Terrestrial vs Generalist, it is 0.76 (0.50, 0.92) in both packages (brms: 0.49, 0.92). Both packages indicate that a large part of the latent-scale variation in these contrasts is attributed to phylogeny, i.e. closely related species tend to have similar lifestyles.
One continuous explanatory variable model
MCMCglmm
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior5 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 20,
alpha.mu = rep(0, 2), alpha.V = diag(2)*(pi^2/3))
)
)
system.time(
mcmcglmm_mn1_2 <- run_mcmcglmm_chains(Primary.Lifestyle ~ log_Tail_Length_centered:trait + trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior5,
seeds = c(20265226, 20265227, 20265228, 20265229), # one seed per chain (four chains)
nitt = 13000*200,
thin = 10*200,
burnin = 3000*200
)
)brms
priors_brms2 <- nominal_priors("log_Tail_Length_centered")
system.time(
brms_mn1_2 <- brm(Primary.Lifestyle ~ log_Tail_Length_centered + (1 |a| gr(Phylo, cov = A)),
data = dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms2,
iter = 15000,
warmup = 10000,
chains = 4,
cores = 4,
seed = 20270626,
thin = 1
)
)Output correction and summary
summarise_chains(mcmcglmm_mn1_2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitPrimary.Lifestyle.Insessorial -0.9554 3.110 -7.7960 4.8520 1.001 3656 3226
#> 2 traitPrimary.Lifestyle.Terrestrial 3.1520 2.925 -2.1450 9.6970 1.001 3725 3812
#> 3 log_Tail_Length_centered:traitPrimary.Lifestyle.Insessorial -1.2340 2.159 -5.8620 2.6810 1.000 3689 3812
#> 4 log_Tail_Length_centered:traitPrimary.Lifestyle.Terrestrial -2.6770 2.148 -7.0490 1.4810 1.000 3906 3633
#> 5 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 18.4000 12.550 3.8860 51.1600 1.001 2663 2855
#> 6 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -0.8501 4.683 -10.3000 8.7690 1.001 3798 3526
#> 7 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -0.8501 4.683 -10.3000 8.7690 1.001 3798 3526
#> 8 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 18.8500 12.920 4.2340 52.7200 1.000 2455 2858
#> 9 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
#> 10 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 11 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 12 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn1_2, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn1_2, "VCV") / (1 + c2a) # (co)variances; the units (residual) rows are fixed, not estimated
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial -0.8612723 2.803701 -7.027441 4.373773
#> traitPrimary.Lifestyle.Terrestrial 2.8409701 2.637037 -1.933388 8.741751
#> log_Tail_Length_centered:traitPrimary.Lifestyle.Insessorial -1.1128506 1.945898 -5.283948 2.417050
#> log_Tail_Length_centered:traitPrimary.Lifestyle.Terrestrial -2.4134294 1.936139 -6.354559 1.335403
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 14.9506323 10.196735 3.1576515 41.5741178
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -0.6908167 3.805556 -8.3737632 7.1258724
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -0.6908167 3.805556 -8.3737632 7.1258724
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 15.3168361 10.495985 3.4403951 42.8459507
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each posterior draw
# (a correlation is not changed by the c2 correction, so the raw (co)variances can be used)
VCV <- pool_chains(mcmcglmm_mn1_2, "VCV")
corr_phylo <- VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo"] /
sqrt(VCV[, "traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo"] * VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.05767058 0.2283348 -0.4889063 0.4003758
summary(brms_mn1_2)
#> Family: categorical
#> Links: muInsessorial = logit; muTerrestrial = logit
#> Formula: Primary.Lifestyle ~ log_Tail_Length_centered + (1 | a | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 173)
#> Draws: 4 chains, each with iter = 15000; warmup = 10000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 173)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muInsessorial_Intercept) 3.45 1.06 1.66 5.77 1.00 7494 11487
#> sd(muTerrestrial_Intercept) 3.62 1.12 1.75 6.09 1.00 6387 10639
#> cor(muInsessorial_Intercept,muTerrestrial_Intercept) -0.17 0.33 -0.76 0.48 1.00 3875 7814
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muInsessorial_Intercept -0.19 1.09 -2.50 1.87 1.00 26606 11739
#> muTerrestrial_Intercept 0.58 1.17 -1.45 3.21 1.00 23137 9866
#> muInsessorial_log_Tail_Length_centered -0.88 1.86 -4.73 2.60 1.00 18463 14741
#> muTerrestrial_log_Tail_Length_centered -2.24 1.82 -5.92 1.24 1.00 18016 15183
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The slopes of tail length are negative for both contrasts in both packages (c2-corrected MCMCglmm: −1.11 [−5.28, 2.42] for Insessorial and −2.41 [−6.35, 1.34] for Terrestrial; brms: −0.88 [−4.73, 2.60] and −2.24 [−5.92, 1.24]), but all 95% CIs include zero. The phylogenetic variances are large (c2-corrected MCMCglmm variances 15.0 and 15.3; brms SDs 3.45 and 3.62), and the phylogenetic correlation between the two contrasts is weak and uncertain (−0.06 [−0.49, 0.40] and −0.17 [−0.76, 0.48]). The two packages give similar estimates.
Model with one continuous and one binary explanatory variable
MCMCglmm
prior5 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 20,
alpha.mu = rep(0, 2), alpha.V = diag(2)*(pi^2/3))
)
)
system.time(
mcmcglmm_mn1_3 <- run_mcmcglmm_chains(Primary.Lifestyle ~ log_Tail_Length_centered:trait + IsOmnivore:trait + trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = dat,
prior = prior5,
seeds = c(20265326, 20265327, 20265328, 20265329), # one seed per chain (four chains)
nitt = 13000*250,
thin = 10*250,
burnin = 3000*250
)
)brms
# the same weakly informative priors as for models 1 and 2 (see nominal_priors() above)
custom_priors <- nominal_priors(c("log_Tail_Length_centered", "IsOmnivore"))
system.time(
brms_mn1_3 <- brm(
Primary.Lifestyle ~ log_Tail_Length_centered + IsOmnivore + (1 |a| gr(Phylo, cov = A)),
data = dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = custom_priors,
iter = 15000,
warmup = 10000,
chains = 4,
cores = 4,
seed = 20270326,
thin = 1
)
)Outputs are…
summarise_chains(mcmcglmm_mn1_3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitPrimary.Lifestyle.Insessorial -1.3670 3.510 -9.1020 4.9220 1.000 3528 3540
#> 2 traitPrimary.Lifestyle.Terrestrial 4.0320 3.017 -0.7998 10.9400 1.000 3591 3682
#> 3 log_Tail_Length_centered:traitPrimary.Lifestyle.Insessorial -1.2630 2.378 -6.1590 3.1260 1.001 3705 3786
#> 4 log_Tail_Length_centered:traitPrimary.Lifestyle.Terrestrial -1.9340 2.282 -6.5810 2.2900 1.001 3463 3528
#> 5 traitPrimary.Lifestyle.Insessorial:IsOmnivore 0.1230 1.065 -1.8400 2.4450 1.000 3016 2888
#> 6 traitPrimary.Lifestyle.Terrestrial:IsOmnivore -5.1330 1.400 -8.5070 -3.0240 1.000 2203 2692
#> 7 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 23.4400 15.860 5.0000 62.9100 1.000 2570 2883
#> 8 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -1.7940 5.434 -14.6500 8.2370 1.000 2771 2430
#> 9 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -1.7940 5.434 -14.6500 8.2370 1.000 2771 2430
#> 10 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 16.7100 15.520 0.4001 55.2900 1.000 1813 2163
#> 11 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
#> 12 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 13 traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.3333 0.000 0.3333 0.3333 NA NA NA
#> 14 traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.6667 0.000 0.6667 0.6667 NA NA NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn1_3, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn1_3, "VCV") / (1 + c2a) # (co)variances; the units (residual) rows are fixed, not estimated
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial -1.2323992 3.1638373 -8.2055382 4.437070
#> traitPrimary.Lifestyle.Terrestrial 3.6344251 2.7201356 -0.7209607 9.862223
#> log_Tail_Length_centered:traitPrimary.Lifestyle.Insessorial -1.1382685 2.1435010 -5.5519990 2.818025
#> log_Tail_Length_centered:traitPrimary.Lifestyle.Terrestrial -1.7434276 2.0571589 -5.9326730 2.064426
#> traitPrimary.Lifestyle.Insessorial:IsOmnivore 0.1108556 0.9600501 -1.6584532 2.204396
#> traitPrimary.Lifestyle.Terrestrial:IsOmnivore -4.6270949 1.2624973 -7.6686042 -2.726334
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo 19.0450408 12.888904 4.0631255 51.1231196
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo -1.4580410 4.415706 -11.9056762 6.6936544
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.Phylo -1.4580410 4.415706 -11.9056762 6.6936544
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo 13.5753700 12.616010 0.3251009 44.9286093
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Terrestrial.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each posterior draw
# (a correlation is not changed by the c2 correction, so the raw (co)variances can be used)
VCV <- pool_chains(mcmcglmm_mn1_3, "VCV")
corr_phylo <- VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Insessorial.Phylo"] /
sqrt(VCV[, "traitPrimary.Lifestyle.Insessorial:traitPrimary.Lifestyle.Insessorial.Phylo"] * VCV[, "traitPrimary.Lifestyle.Terrestrial:traitPrimary.Lifestyle.Terrestrial.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.09887199 0.2389172 -0.5391202 0.3738546
summary(brms_mn1_3)
#> Family: categorical
#> Links: muInsessorial = logit; muTerrestrial = logit
#> Formula: Primary.Lifestyle ~ log_Tail_Length_centered + IsOmnivore + (1 | a | gr(Phylo, cov = A))
#> Data: dat (Number of observations: 173)
#> Draws: 4 chains, each with iter = 15000; warmup = 10000; thin = 1;
#> total post-warmup draws = 20000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 173)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muInsessorial_Intercept) 3.86 1.16 1.87 6.39 1.00 7032 10377
#> sd(muTerrestrial_Intercept) 2.96 1.42 0.36 5.93 1.00 3675 4309
#> cor(muInsessorial_Intercept,muTerrestrial_Intercept) -0.22 0.35 -0.82 0.51 1.00 7400 10609
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muInsessorial_Intercept -0.29 1.23 -2.90 2.01 1.00 20980 10780
#> muTerrestrial_Intercept 2.55 1.15 0.62 5.09 1.00 13453 12633
#> muInsessorial_log_Tail_Length_centered -0.92 2.00 -5.15 2.79 1.00 20438 15111
#> muInsessorial_IsOmnivore 0.12 0.90 -1.59 1.97 1.00 17370 15540
#> muTerrestrial_log_Tail_Length_centered -1.53 1.92 -5.38 2.23 1.00 20721 13386
#> muTerrestrial_IsOmnivore -4.46 1.09 -6.96 -2.75 1.00 8126 12176
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).- The slopes of tail length are negative for both contrasts in both packages, but their 95% CIs include zero, so there is no clear evidence for an effect.
- Omnivorous thrushes are much less likely than non-omnivorous thrushes to be terrestrial rather than generalist:
IsOmnivorefor the Terrestrial contrast is −4.63 (95% CI −7.67, −2.73; c2-corrected) inMCMCglmmand −4.46 (−6.96, −2.75) inbrms. There is no clear difference for the Insessorial contrast (0.11 and 0.12, with intervals including zero). - Results from
MCMCglmmandbrmsare consistent in the direction and magnitude of the effects. - The phylogenetic correlation between the two contrasts is weak and uncertain (−0.10 and −0.22).
Example 2
We use habitat-category data for the Sylviidae (Old World warblers; 294 species) as the response variable. Body mass and sedentary status (IsSedentary: 1 = sedentary, 0 = partially migratory or migratory) are used as explanatory variables.
Dataset for example 2
For Example 2, data for the Sylviidae (Old World warblers) were extracted from the AVONET dataset. The habitat categories were reclassified into three categories, migration status was converted into a binary variable (IsSedentary, 1 = sedentary), and body mass was log-transformed and centred.
dat <- read.csv(here("data", "bird body mass", "9993spp_clearned.csv"))
dat <- dat %>%
mutate(across(c(Trophic.Level, Trophic.Niche,
Primary.Lifestyle, Migration, Habitat, Habitat.Density, Species.Status), as.factor),
Habitat.Density = factor(Habitat.Density, ordered = TRUE))
dat <- dat %>%
mutate(
Habitat_Category = case_when(
Habitat %in% c("Desert", "Rock", "Grassland", "Shrubland") ~ "Arid_Open",
Habitat %in% c("Woodland", "Forest") ~ "Forested_Vegetated",
Habitat == "Human modified" ~ "Human-Modified",
Habitat %in% c("Riverine", "Coastal", "Marine", "Wetland") ~ "Aquatic_Coastal",
TRUE ~ "Other"
)
)
Family_habitat <- dat %>%
group_by(Family, Habitat_Category) %>%
tally() %>%
group_by(Family) %>%
ungroup()
Sylviidae_dat <- dat %>%
filter(Family == "Sylviidae") %>%
mutate(Habitat_Category = factor(Habitat_Category, ordered = FALSE))
Sylviidae_dat <- Sylviidae_dat %>%
mutate(IsSedentary = ifelse(Migration == "1", 1, 0) # AVONET: Migration 1 = sedentary
)
table(Sylviidae_dat$Habitat_Category)
Sylviidae_dat <- Sylviidae_dat %>%
mutate(Habitat_Category = recode(Habitat_Category,
"Aquatic_Coastal" = "Others",
"Other" = "Others"))
Sylviidae_dat$cMass <- scale(log(Sylviidae_dat$Mass), center = TRUE, scale = FALSE)
Sylviidae_tree <- read.nexus(here("data", "bird body mass", "Sylviidae.nex"))
tree <- Sylviidae_tree[[1]]Intercept-only model
MCMCglmm
inv_phylo <- inverseA(tree, nodes = "ALL", scale = TRUE)
prior <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 20,
alpha.mu = rep(0, 2), alpha.V = diag(2)*(pi^2/3))
)
)
mcmcglmm_mn2_1 <- run_mcmcglmm_chains(Habitat_Category ~ trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = Sylviidae_dat,
prior = prior,
seeds = c(20265426, 20265427, 20265428, 20265429), # one seed per chain (four chains)
nitt = 13000*500,
thin = 10*500,
burnin = 3000*500
)brms
A <- ape::vcv.phylo(tree, corr = TRUE)
priors_brms1 <- default_prior(Habitat_Category ~ 1 + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit")
)
system.time(
brms_mn2_1 <- brm(Habitat_Category ~ 1 + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms1,
iter = 18000,
warmup = 8000,
chains = 4,
cores = 4,
seed = 20272326,
thin = 1
)
)Before checking the output, we need to correct the results from MCMCglmm using the following equation:
c2 <- (16 * sqrt(3) / (15 * pi))^2
c2a <- c2*(2/3)summarise_chains(mcmcglmm_mn2_1)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk
#> 1 traitHabitat_Category.Arid_Open 2.3960 1.247 0.08665 4.9900 0.999 3010
#> 2 traitHabitat_Category.Forested_Vegetated 4.5260 1.575 1.85600 8.0370 1.000 3599
#> 3 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 7.1010 4.635 1.56500 19.7000 1.001 3627
#> 4 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 1.9300 2.490 -2.09400 7.8600 1.000 3593
#> 5 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 1.9300 2.490 -2.09400 7.8600 1.000 3593
#> 6 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 14.5300 7.932 4.60000 33.8700 1.000 3351
#> 7 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.6667 0.000 0.66670 0.6667 NA NA
#> 8 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.3333 0.000 0.33330 0.3333 NA NA
#> 9 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.3333 0.000 0.33330 0.3333 NA NA
#> 10 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.6667 0.000 0.66670 0.6667 NA NA
#> ess_tail
#> 1 3708
#> 2 3765
#> 3 3935
#> 4 3598
#> 5 3598
#> 6 3373
#> 7 NA
#> 8 NA
#> 9 NA
#> 10 NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn2_1, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn2_1, "VCV") / (1 + c2a) # (co)variances; the units (residual) rows are fixed, not estimated
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open 2.160304 1.124218 0.07810752 4.498600
#> traitHabitat_Category.Forested_Vegetated 4.079834 1.420158 1.67266839 7.245016
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 5.7702266 3.766750 1.2715460 16.0126913
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 1.5681213 2.023516 -1.7013510 6.3871177
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 1.5681213 2.023516 -1.7013510 6.3871177
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 11.8072430 6.446057 3.7381973 27.5219928
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each posterior draw
# (a correlation is not changed by the c2 correction, so the raw (co)variances can be used)
VCV <- pool_chains(mcmcglmm_mn2_1, "VCV")
corr_phylo <- VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo"] /
sqrt(VCV[, "traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo"] * VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.1891776 0.2055073 -0.22399 0.5703709
summary(brms_mn2_1)
#> Family: categorical
#> Links: muAridOpen = logit; muForestedVegetated = logit
#> Formula: Habitat_Category ~ 1 + (1 | a | gr(Phylo, cov = A))
#> Data: Sylviidae_dat (Number of observations: 294)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 294)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muAridOpen_Intercept) 2.56 0.89 1.22 4.64 1.00 7469 12859
#> sd(muForestedVegetated_Intercept) 4.16 1.31 2.22 7.20 1.00 4175 10490
#> cor(muAridOpen_Intercept,muForestedVegetated_Intercept) 0.44 0.30 -0.25 0.90 1.00 2042 5685
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muAridOpen_Intercept 2.23 1.15 -0.00 4.62 1.00 6913 13544
#> muForestedVegetated_Intercept 3.62 1.49 0.90 6.83 1.00 24620 22982
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The category-specific phylogenetic variance proportions (reference category: Others) are…
# Category-specific phylogenetic variance proportion on the latent scale of the
# reference-category multinomial logit (reference: Others):
# sigma2_phylo / (sigma2_phylo + pi^2/3), calculated for each posterior draw
## MCMCglmm: c2-corrected phylogenetic variances
var_Arid_Open <- pool_chains(mcmcglmm_mn2_1, "VCV")[, "traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo"] / (1 + c2a)
var_Forested_Vegetated <- pool_chains(mcmcglmm_mn2_1, "VCV")[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo"] / (1 + c2a)
posterior_summary(var_Arid_Open / (var_Arid_Open + pi^2 / 3)) # Arid_Open vs Others
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.5847748 0.142353 0.2787614 0.8295631
posterior_summary(var_Forested_Vegetated / (var_Forested_Vegetated + pi^2 / 3)) # Forested_Vegetated vs Others
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.7473551 0.09442562 0.5318956 0.8932272
## brms
draws <- as_draws_df(brms_mn2_1)
posterior_summary(with(draws, sd_Phylo__muAridOpen_Intercept^2 / (sd_Phylo__muAridOpen_Intercept^2 + pi^2 / 3)))
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.6276732 0.1459667 0.3124393 0.8676483
posterior_summary(with(draws, sd_Phylo__muForestedVegetated_Intercept^2 / (sd_Phylo__muForestedVegetated_Intercept^2 + pi^2 / 3)))
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.8118798 0.08821898 0.5995163 0.9402853The reference category is Others, which contains the 34 wetland species plus one species associated with human-modified habitats and one species without habitat information. The intercepts are the log-odds of each habitat category relative to Others for a species at the phylogenetic mean. They are positive (c2-corrected MCMCglmm: 2.16 [0.08, 4.50] for Arid_Open and 4.08 [1.67, 7.25] for Forested_Vegetated; brms: 2.23 [−0.00, 4.62] and 3.62 [0.90, 6.83]), reflecting that most warblers are in the two larger categories.
The phylogenetic variance proportion is higher for the Forested_Vegetated vs Others contrast (0.75, 95% CI 0.53, 0.89 in MCMCglmm; 0.81, 0.60, 0.94 in brms) than for Arid_Open vs Others (0.58, 0.28, 0.83; 0.63, 0.31, 0.87). The phylogenetic correlation between the two contrasts tends to be positive (0.19 [−0.22, 0.57] and 0.44 [−0.25, 0.90]), but its 95% credible intervals include zero in both packages.
One continuous explanatory variable model
MCMCglmm
mcmcglmm_mn2_2 <- run_mcmcglmm_chains(Habitat_Category ~ cMass:trait + trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = Sylviidae_dat,
prior = prior,
seeds = c(20265526, 20265527, 20265528, 20265529), # one seed per chain (four chains)
nitt = 13000*500,
thin = 10*500,
burnin = 3000*500
)brms
A <- ape::vcv.phylo(tree, corr = TRUE)
priors_brms2 <- default_prior(Habitat_Category ~ cMass + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit")
)
system.time(
brms_mn2_2 <- brm(Habitat_Category ~ cMass + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms2,
iter = 18000,
warmup = 8000,
chains = 4,
cores = 4,
seed = 20272926,
control = list(adapt_delta = 0.999),
thin = 1
)
)summarise_chains(mcmcglmm_mn2_2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk
#> 1 traitHabitat_Category.Arid_Open 2.6340 1.3220 0.2029 5.4390 1.001 3283
#> 2 traitHabitat_Category.Forested_Vegetated 4.7240 1.7630 1.6470 8.6880 1.000 3461
#> 3 cMass:traitHabitat_Category.Arid_Open -0.7872 0.7814 -2.3650 0.7039 1.000 3642
#> 4 cMass:traitHabitat_Category.Forested_Vegetated 1.0230 0.9563 -0.8467 2.9920 1.000 4112
#> 5 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 7.6270 5.3110 1.5310 20.8300 1.001 3280
#> 6 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 2.2770 3.1490 -2.6480 10.0800 1.001 3451
#> 7 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 2.2770 3.1490 -2.6480 10.0800 1.001 3451
#> 8 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 18.5300 10.2100 5.8350 43.7200 1.001 3130
#> 9 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.6667 0.0000 0.6667 0.6667 NA NA
#> 10 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.3333 0.0000 0.3333 0.3333 NA NA
#> 11 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.3333 0.0000 0.3333 0.3333 NA NA
#> 12 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.6667 0.0000 0.6667 0.6667 NA NA
#> ess_tail
#> 1 3509
#> 2 3419
#> 3 3738
#> 4 4055
#> 5 3380
#> 6 3233
#> 7 3233
#> 8 3314
#> 9 NA
#> 10 NA
#> 11 NA
#> 12 NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn2_2, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn2_2, "VCV") / (1 + c2a) # (co)variances; the units (residual) rows are fixed, not estimated
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open 2.3748428 1.1914160 0.1829041 4.903220
#> traitHabitat_Category.Forested_Vegetated 4.2581539 1.5891416 1.4844561 7.832036
#> cMass:traitHabitat_Category.Arid_Open -0.7096197 0.7044276 -2.1317032 0.634580
#> cMass:traitHabitat_Category.Forested_Vegetated 0.9218267 0.8620547 -0.7632911 2.696953
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 6.1981391 4.316021 1.2439553 16.9307269
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 1.8500984 2.559050 -2.1519801 8.1937077
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 1.8500984 2.559050 -2.1519801 8.1937077
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 15.0599978 8.298526 4.7420004 35.5286096
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each posterior draw
# (a correlation is not changed by the c2 correction, so the raw (co)variances can be used)
VCV <- pool_chains(mcmcglmm_mn2_2, "VCV")
corr_phylo <- VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo"] /
sqrt(VCV[, "traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo"] * VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.1888491 0.2145376 -0.2500307 0.578823
summary(brms_mn2_2)
#> Family: categorical
#> Links: muAridOpen = logit; muForestedVegetated = logit
#> Formula: Habitat_Category ~ cMass + (1 | a | gr(Phylo, cov = A))
#> Data: Sylviidae_dat (Number of observations: 294)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 294)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muAridOpen_Intercept) 2.65 0.98 1.23 5.00 1.00 4779 8265
#> sd(muForestedVegetated_Intercept) 4.98 1.67 2.57 8.96 1.00 2954 7819
#> cor(muAridOpen_Intercept,muForestedVegetated_Intercept) 0.46 0.32 -0.26 0.92 1.00 1283 3844
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muAridOpen_Intercept 2.42 1.20 0.07 4.94 1.00 3950 8590
#> muForestedVegetated_Intercept 3.58 1.70 0.45 7.21 1.00 19446 18306
#> muAridOpen_cMass -0.57 0.77 -2.13 0.91 1.00 11786 15863
#> muForestedVegetated_cMass 1.28 1.06 -0.64 3.56 1.00 12291 16100
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Summary
Intercepts: The intercepts are the log-odds of belonging to a habitat category rather than the reference category (
Others) for a species of average body mass (cMassis centred, socMass = 0is the mean log body mass) at the phylogenetic mean. They are positive for Arid_Open and Forested_Vegetated (c2-correctedMCMCglmm: 2.37 [0.18, 4.90] and 4.26 [1.48, 7.83];brms: 2.43 [0.08, 4.94] and 3.58 [0.45, 7.21]). Such species are therefore more likely to occur in these two habitat categories than inOthers.Mass effects: The slope of centred log body mass (
cMass) is negative for Arid_Open (−0.71 and −0.57) and positive for Forested_Vegetated (0.92 and 1.28), but in both packages the 95% credible intervals include zero, so there is no clear evidence for an effect.Phylogenetic variances: Substantial phylogenetic variance remains for both contrasts (c2-corrected
MCMCglmmvariances 6.20 and 15.06;brmsSDs 2.65 and 4.98).Phylogenetic correlation: The correlation between the two contrasts is positive but highly uncertain (0.19 [−0.25, 0.58] and 0.46 [−0.26, 0.92]), with 95% credible intervals including zero.
Model with one continuous and one binary explanatory variable
MCMCglmm
mcmcglmm_mn2_3 <- run_mcmcglmm_chains(Habitat_Category ~ cMass:trait + IsSedentary:trait + trait -1,
random = ~us(trait):Phylo,
rcov = ~us(trait):units,
ginverse = list(Phylo = inv_phylo$Ainv),
family = "categorical",
data = Sylviidae_dat,
prior = prior,
seeds = c(20262126, 20262127, 20262128, 20262129), # one seed per chain (four chains)
nitt = 13000*750,
thin = 10*750,
burnin = 3000*750
)brms
A <- ape::vcv.phylo(tree, corr = TRUE)
priors_brms3 <- default_prior(Habitat_Category ~ cMass + IsSedentary + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit")
)
system.time(
brms_mn2_3 <- brm(Habitat_Category ~ cMass + IsSedentary + (1 |a| gr(Phylo, cov = A)),
data = Sylviidae_dat,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms3,
iter = 18000,
warmup = 8000,
chains = 4,
cores = 4,
seed = 20272826,
control = list(adapt_delta = 0.999),
thin = 1
)
)summarise_chains(mcmcglmm_mn2_3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk
#> 1 traitHabitat_Category.Arid_Open 2.4200 1.4200 -0.1270 5.4920 1.000 3726
#> 2 traitHabitat_Category.Forested_Vegetated 2.5190 1.8150 -0.9269 6.3210 1.001 3770
#> 3 cMass:traitHabitat_Category.Arid_Open -0.9057 0.8288 -2.5890 0.7164 1.000 4002
#> 4 cMass:traitHabitat_Category.Forested_Vegetated 0.8202 1.0510 -1.1400 3.0170 1.000 3482
#> 5 traitHabitat_Category.Arid_Open:IsSedentary 0.4466 0.7255 -0.9812 1.8400 1.000 4126
#> 6 traitHabitat_Category.Forested_Vegetated:IsSedentary 3.0130 0.9842 1.2350 5.1370 1.000 3691
#> 7 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 9.2020 6.8050 1.7900 26.9800 1.001 3158
#> 8 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 1.8500 3.5310 -4.0690 10.0900 1.001 3633
#> 9 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 1.8500 3.5310 -4.0690 10.0900 1.001 3633
#> 10 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 20.2300 12.3800 5.6640 50.6900 1.000 3169
#> 11 traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.6667 0.0000 0.6667 0.6667 NA NA
#> 12 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.3333 0.0000 0.3333 0.3333 NA NA
#> 13 traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.3333 0.0000 0.3333 0.3333 NA NA
#> 14 traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.6667 0.0000 0.6667 0.6667 NA NA
#> ess_tail
#> 1 3759
#> 2 3520
#> 3 3763
#> 4 3891
#> 5 3836
#> 6 3559
#> 7 3358
#> 8 3541
#> 9 3541
#> 10 3408
#> 11 NA
#> 12 NA
#> 13 NA
#> 14 NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mcmcglmm_mn2_3, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mcmcglmm_mn2_3, "VCV") / (1 + c2a) # (co)variances; the units rows are fixed
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open 2.1813459 1.2797391 -0.1145080 4.9509953
#> traitHabitat_Category.Forested_Vegetated 2.2709316 1.6358620 -0.8355574 5.6985839
#> cMass:traitHabitat_Category.Arid_Open -0.8164503 0.7471639 -2.3336545 0.6458467
#> cMass:traitHabitat_Category.Forested_Vegetated 0.7393625 0.9476727 -1.0278661 2.7197079
#> traitHabitat_Category.Arid_Open:IsSedentary 0.4026041 0.6540102 -0.8844728 1.6585819
#> traitHabitat_Category.Forested_Vegetated:IsSedentary 2.7157353 0.8872243 1.1128631 4.6308503
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo 7.4781171 5.530261 1.4546449 21.9218257
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo 1.5035466 2.869816 -3.3064294 8.1966051
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.Phylo 1.5035466 2.869816 -3.3064294 8.1966051
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo 16.4417601 10.061428 4.6023748 41.1917348
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.units 0.5417579 0.000000 0.5417579 0.5417579
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Arid_Open:traitHabitat_Category.Forested_Vegetated.units 0.2708789 0.000000 0.2708789 0.2708789
#> traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.units 0.5417579 0.000000 0.5417579 0.5417579
# phylogenetic correlation between the two contrasts, calculated for each pooled draw
VCV <- pool_chains(mcmcglmm_mn2_3, "VCV")
corr_phylo <- VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Arid_Open.Phylo"] /
sqrt(VCV[, "traitHabitat_Category.Arid_Open:traitHabitat_Category.Arid_Open.Phylo"] *
VCV[, "traitHabitat_Category.Forested_Vegetated:traitHabitat_Category.Forested_Vegetated.Phylo"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.1346218 0.2216828 -0.3129609 0.5467625
summary(brms_mn2_3)
#> Family: categorical
#> Links: muAridOpen = logit; muForestedVegetated = logit
#> Formula: Habitat_Category ~ cMass + IsSedentary + (1 | a | gr(Phylo, cov = A))
#> Data: Sylviidae_dat (Number of observations: 294)
#> Draws: 4 chains, each with iter = 18000; warmup = 8000; thin = 1;
#> total post-warmup draws = 40000
#>
#> Multilevel Hyperparameters:
#> ~Phylo (Number of levels: 294)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muAridOpen_Intercept) 2.95 1.26 1.27 6.04 1.00 5011 8361
#> sd(muForestedVegetated_Intercept) 6.49 3.47 2.66 15.31 1.00 2716 6752
#> cor(muAridOpen_Intercept,muForestedVegetated_Intercept) 0.35 0.36 -0.44 0.91 1.00 1289 2677
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muAridOpen_Intercept 2.06 1.30 -0.48 4.72 1.00 8225 13625
#> muForestedVegetated_Intercept 0.77 2.35 -4.34 5.03 1.00 12228 10688
#> muAridOpen_cMass -0.63 0.83 -2.33 0.94 1.00 12284 16991
#> muAridOpen_IsSedentary 0.52 0.73 -0.92 1.97 1.00 13563 18266
#> muForestedVegetated_cMass 1.47 1.43 -0.84 4.72 1.00 8076 11250
#> muForestedVegetated_IsSedentary 3.66 1.75 1.36 8.03 1.00 7658 8239
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The first four-chain brms fit of this model (with the default adapt_delta) had 441 divergent transitions. With adapt_delta = 0.999, there are none, and the four chains agree (R-hat < 1.01).
IsSedentary is 1 for sedentary species and 0 for partially migratory or migratory species, so its coefficient compares sedentary with (partially) migratory species. For the Forested_Vegetated vs Others contrast, the coefficient is positive and its 95% CI excludes zero (c2-corrected MCMCglmm: 2.72, 95% CI 1.11, 4.63; brms: 3.66, 1.36, 8.03). For Arid_Open vs Others, it is small and uncertain (0.40, −0.88, 1.66 and 0.52, −0.93, 1.97). The slopes of body mass are similar to those of the previous model, and their 95% CIs include zero.
For the Forested_Vegetated contrast, the brms estimates are larger in magnitude and much more uncertain than those of MCMCglmm: the phylogenetic SD is 6.49 (2.66, 15.31) in brms, compared with a c2-corrected MCMCglmm variance of 16.44 (i.e. an SD of about 4), and the intercept is 0.77 (−4.34, 5.03) in brms and 2.27 (−0.84, 5.70) in MCMCglmm. The reference category contains only 36 species, so the data contain limited information about this contrast once sedentary status is included, and the estimates depend on the priors of each package. The direction of the effect of sedentary status is the same in both packages.
Summary
Body mass: There is no clear evidence that heavier or lighter species are more likely to be in Arid_Open or Forested_Vegetated habitats rather than in
Others.Sedentary status: Sedentary species are more likely than partially migratory or migratory species to be in Forested_Vegetated habitats rather than in
Others, after accounting for body mass and phylogeny; the magnitude of this effect is uncertain and differs between the packages. There is no clear difference for Arid_Open habitats.Phylogenetic patterns: The phylogenetic correlation between the two contrasts is positive but uncertain (0.13, 95% CI −0.31, 0.55 in
MCMCglmm; 0.35, −0.44, 0.91 inbrms), and both intervals include zero.
Extension: models with multiple data points per species
Tips for simulating datasets
Unfortunately, there are few published datasets with multiple data points per species. We therefore simulate Gaussian, binary, ordinal and nominal data for this section and fit MCMCglmm and brms models to them.
Before moving on to each section, we share some tips to keep in mind when simulating data:
Make the dataset as realistic as possible
Simulated data should reflect the real-world context. If you are simulating biological data, consider the typical distributions, relationships, and range of values that could appear in your real dataset. You may need to check published studies to assess whether your assumptions are suitable.Carefully define random effect(s) and fixed effect(s) parameters
For generating a response variable, ensure that both fixed and random effects are specified clearly. The fixed effects could represent known, deterministic influences (like treatment groups), while random effects account for variability due to unmeasured factors (like species or individuals). Choose the variance components (including the residual variance) so that they represent the data-generating scenario you want to study; there is no general rule about whether the residual variance should be smaller or larger than the random-effect variances. Keep track of whether each parameter is a variance or a standard deviation.Check true values (we set) and model estimates
After generating the data and fitting your model, compare the “true” parameter values you set for the simulation with the estimates your model provides. This will help you assess the accuracy of your model and how well it can recover the true underlying parameters. It is important to check whether the model overestimates or underestimates certain effects.Ensure all created variables are properly aligned
When simulating data, it is essential to check that all the variables are correctly aligned and correspond to each other as intended. Specifically, pay attention to the following points:Matching species names with those in the phylogenetic tree
Ensure that the species names used in your data set are consistent with those in the phylogenetic tree (if applicable). If these names don’t match, the integrity of the data could be compromised, leading to inaccurate results (or the model cannot run). For instance, if a species is named “SpeciesA” in the data but referred to as “SpeciesB” in the phylogeny, the data won’t be interpreted correctly.Correspondence between variables
Also check that other variables, such as individual IDs, environmental factors, gender, or group differences, are correctly matched. For example, verify that data points for each individual are correctly associated with the intended ID, and that variables like age and gender follow expected distributions. How to check: After creating your data frame, use functions, such ashead(),summary(), orView()in R (you can find other functions as well) to check for any discrepancies, such as duplicated species names or missing values. This helps ensure that your dataset is internally consistent.
Other small things…
- Read the documentation
It may not be worth mentioning again, but always read the documentation for the functions you are using. Understand how they work, what parameters they take, and what outputs they produce. - Test with small examples
If you are using a new function, start by testing it on a small sample of data to see how it behaves before using it in your actual analysis. This helps you avoid larger mistakes when you apply it to the full dataset. - Stick to familiar methods
However, stick to methods and functions you are familiar with, especially when you are starting. As you encounter issues or need more advanced features, gradually learn new functions and techniques. It is a safer approach and will help you build confidence.
Simulate datasets and run models
The simulated datasets are saved in data/simulated/ together with their trees and true parameter values. This function reads one of them:
# Read a canonical simulated dataset and its tree (see generate_simulated_data.R).
read_simulated_data <- function(name, dir = here("data", "simulated")) {
d <- read.csv(file.path(dir, paste0("sim_", name, ".csv")))
d$sex <- factor(d$sex, levels = c("F", "M"))
if (name == "ordinal") d$aggressive_level <- factor(d$aggressive_level, levels = c("Low", "Medium", "High"), ordered = TRUE)
if (name == "nominal") d$lateralisation <- factor(d$lateralisation, levels = c("Both", "Left", "Right"))
list(data = d, tree = ape::read.tree(file.path(dir, paste0("sim_", name, "_tree.nwk"))),
effects = read.csv(file.path(dir, paste0("sim_", name, "_effects.csv"))),
params = jsonlite::read_json(file.path(dir, paste0("sim_", name, "_params.json")), simplifyVector = TRUE))
}In this extension, we create datasets for models with different types of response variables: Gaussian, binary, ordinal, and nominal traits. The explanatory variables are the same in all datasets (body mass and sex), except for the nominal example, which is intercept-only. All datasets consist of 100 bird species, each observed five times.
Gaussian
We simulated the habitat range (log-transformed) of each species as the continuous response variable. We assumed habitat range is more strongly influenced by body mass than by sex, and phylogenetic factors are expected to have a greater impact than non-phylogenetic factors.
# Code used to generate the canonical dataset (see data/simulated/generate_simulated_data.R).
# Phylogenetically structured values are drawn with u = L z, where L = t(chol(Sigma)).
# helper functions used by all simulations
suppressMessages({library(ape); library(phytools); library(dplyr); library(jsonlite)})
out_dir <- file.path("data", "simulated")
# one draw from N(mu, Sigma) using the lower-triangular Cholesky factor
rmvnorm_chol <- function(mu, Sigma) {
L <- t(chol(Sigma))
stopifnot(max(abs(L %*% t(L) - Sigma)) < 1e-10) # L L' reproduces Sigma
as.vector(mu + L %*% rnorm(nrow(Sigma)))
}
make_tree <- function(seed, name) {
set.seed(seed)
tree <- pbtree(n = 100, scale = 1)
f <- file.path(out_dir, paste0("sim_", name, "_tree.nwk"))
write.tree(tree, f, digits = 17)
read.tree(f)
}
save_sim <- function(name, data, effects, params) {
write.csv(data, file.path(out_dir, paste0("sim_", name, ".csv")), row.names = FALSE)
write.csv(effects, file.path(out_dir, paste0("sim_", name, "_effects.csv")), row.names = FALSE)
write_json(params, file.path(out_dir, paste0("sim_", name, "_params.json")), auto_unbox = TRUE, digits = NA, pretty = TRUE)
}
n_species <- 100; obs_per_species <- 5; n <- n_species * obs_per_species
mu_mass <- (log(4) + log(2500)) / 2 # mean log body mass
## 1. Gaussian: habitat range --------------------------------------------------------
seed <- 1234
tree <- make_tree(seed, "gaussian") # set.seed() is called inside, before pbtree()
A <- vcv(tree, corr = TRUE)
mu_species_mass <- rmvnorm_chol(rep(mu_mass, n_species), A)
obs_mass <- as.vector(sapply(mu_species_mass, function(x) rnorm(obs_per_species, mean = x, sd = sqrt(0.1))))
sex <- rbinom(n, 1, 0.5)
var_phylo <- 2; var_non <- 1; var_residual <- 0.2
beta <- c(intercept = 0, mass = 1.2, sexM = 0.1)
u_phylo <- rmvnorm_chol(rep(0, n_species), var_phylo * A)
u_non <- rnorm(n_species, sd = sqrt(var_non))
residual <- rnorm(n, sd = sqrt(var_residual))
species <- rep(tree$tip.label, each = obs_per_species)
y <- beta[["intercept"]] + beta[["mass"]] * obs_mass + beta[["sexM"]] * sex +
rep(u_phylo, each = obs_per_species) + rep(u_non, each = obs_per_species) + residual
save_sim("gaussian",
data.frame(individual_id = 1:n, species = species, phylo = species, habitat_range = y,
mass = obs_mass, sex = factor(sex, levels = 0:1, labels = c("F", "M"))),
data.frame(species = tree$tip.label, phylo_effect = u_phylo, non_phylo_effect = u_non),
list(seed = seed, n_species = n_species, obs_per_species = obs_per_species,
beta = as.list(beta), var_phylo = var_phylo, var_species = var_non, var_residual = var_residual,
mass = list(mean = mu_mass, var_among_species = 1, var_within_species = 0.1)))The simulated dataset, the tree, the simulated species-level effects and the true parameter values are saved in data/simulated/. We use these saved files (rather than re-running the simulation) for fitting and for this tutorial:
sim_gaussian <- read_simulated_data("gaussian")
sim_data1 <- sim_gaussian$data
tree <- sim_gaussian$tree
head(sim_data1) individual_id species phylo habitat_range mass sex
1 1 t84 t84 6.528482 4.552272 M
2 2 t84 t84 6.996712 4.964915 F
3 3 t84 t84 4.915026 4.513204 F
4 4 t84 t84 6.303287 4.400882 F
5 5 t84 t84 4.653596 3.993849 F
6 6 t85 t85 4.351218 5.143677 MRun models
Ainv <- inverseA(tree, nodes = "ALL", scale = TRUE)$Ainv
prior1_mcmcglmm <- list(R = list(V = 1, nu = 0.002),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 100),
G2 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 100)
)
)
system.time(
mod1_mcmcglmm <- run_mcmcglmm_chains(
habitat_range ~ 1,
random = ~ phylo + species,
ginverse = list(phylo = Ainv),
prior = prior1_mcmcglmm,
family = "gaussian",
data = sim_data1,
seeds = c(20266926, 20266927, 20266928, 20266929), # one seed per chain (four chains)
nitt = 13000*60,
thin = 10*60,
burnin = 3000*60
)
)
system.time(
mod1_mcmcglmm2 <- run_mcmcglmm_chains(
habitat_range ~ mass,
random = ~ phylo + species,
ginverse = list(phylo = Ainv),
prior = prior1_mcmcglmm,
family = "gaussian",
data = sim_data1,
seeds = c(20267026, 20267027, 20267028, 20267029), # one seed per chain (four chains)
nitt = 13000*100,
thin = 10*100,
burnin = 3000*100
)
)
system.time(
mod1_mcmcglmm3 <- run_mcmcglmm_chains(
habitat_range ~ mass + sex,
random = ~ phylo + species,
ginverse = list(phylo = Ainv),
prior = prior1_mcmcglmm,
family = "gaussian",
data = sim_data1,
seeds = c(20267126, 20267127, 20267128, 20267129), # one seed per chain (four chains)
nitt = 13000*250,
thin = 10*250,
burnin = 3000*250
)
)
# brms
A <- ape::vcv.phylo(tree, corr = TRUE)
priors1_brms <- default_prior(
habitat_range ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian()
)
system.time(
mod1_brms <- brm(habitat_range ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian(),
prior = priors1_brms,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20267226,
control = list(adapt_delta = 0.95)
)
)
priors1_brms2 <- default_prior(
habitat_range ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian()
)
system.time(
mod1_brms2 <- brm(habitat_range ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian(),
prior = priors1_brms2,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20267326,
control = list(adapt_delta = 0.95)
)
)
priors1_brms3 <- default_prior(
habitat_range ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian()
)
system.time(
mod1_brms3 <- brm(habitat_range ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data1,
data2 = list(A = A),
family = gaussian(),
prior = priors1_brms3,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20267426,
control = list(adapt_delta = 0.95)
)
)Results
The true parameter values (and, for reference only, the realised variances of the simulated species-level effects) are:
sim_gaussian$params # seed and true parameter values used to generate the data$seed
[1] 1234
$n_species
[1] 100
$obs_per_species
[1] 5
$beta
$beta$intercept
[1] 0
$beta$mass
[1] 1.2
$beta$sexM
[1] 0.1
$var_phylo
[1] 2
$var_species
[1] 1
$var_residual
[1] 0.2
$mass
$mass$mean
[1] 4.60517
$mass$var_among_species
[1] 1
$mass$var_within_species
[1] 0.1# realised variances of the simulated species-level effects (for reference only: these are
# sample variances across phylogenetically correlated species, not the model's estimands)
sapply(sim_gaussian$effects[-1], var) phylo_effect non_phylo_effect
1.0396430 0.8428301 summarise_chains(mod1_mcmcglmm)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 5.1280 0.8622 3.4110 6.8280 1 4043 3598
#> 2 phylo 2.8210 1.3160 0.8930 5.8350 1 3207 3571
#> 3 species 0.8734 0.2737 0.4180 1.4750 1 3449 3891
#> 4 units 0.3571 0.0252 0.3124 0.4097 1 3750 3837
summary(mod1_brms)
#> Family: gaussian
#> Links: mu = identity
#> Formula: habitat_range ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data1 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.59 0.37 0.91 2.35 1.00 1192 2437
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.93 0.14 0.66 1.22 1.00 1678 3018
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 5.13 0.76 3.64 6.64 1.00 6755 5368
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.60 0.02 0.56 0.64 1.00 9478 5975
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).autocorr.plot(chains_list(mod1_mcmcglmm, "Sol"))
autocorr.plot(chains_list(mod1_mcmcglmm, "VCV"))
posterior_summary(pool_chains(mod1_mcmcglmm, "Sol")) Estimate Est.Error Q2.5 Q97.5
(Intercept) 5.127816 0.8621979 3.411233 6.828309posterior_summary(pool_chains(mod1_mcmcglmm, "VCV")) Estimate Est.Error Q2.5 Q97.5
phylo 2.8209368 1.31573741 0.8930311 5.8351749
species 0.8734431 0.27374844 0.4179891 1.4751615
units 0.3571458 0.02519675 0.3123906 0.4097058We will now verify whether the model could show estimates close to the true values from the simulated data - there are several points to check during this process. First, check mixing and convergence using the effective sample size, autocorrelation and (for multiple chains) R-hat. Then, compare the true values with the model estimates and check whether the 95% credible intervals contain the true values. The intercept-only model does not include any explanatory variables. The four chains of both packages converged (R-hat < 1.01). Because body mass affects habitat range in the simulation but is not in this model, its effect is absorbed by the other terms. The species’ mean log body masses are phylogenetically structured (variance 1), so the among-species part of the mass effect (\(1.2^2 \times 1 = 1.44\)) adds to the phylogenetic variance, and the within-species part (\(1.2^2 \times 0.1 = 0.144\)) adds to the residual variance. The values expected for this model are therefore a phylogenetic variance of about 3.44, a species variance of 1 and a residual variance of about 0.34, and the intercept is simply the overall mean of habitat range (it is not comparable with the true intercept of 0, which refers to a log body mass of 0). The 95% CIs contain these values: in MCMCglmm, the phylogenetic variance is 2.82 (95% CI 0.89, 5.84), the species variance 0.87 (0.42, 1.48) and the residual variance 0.357 (0.312, 0.410). brms gives similar estimates (SDs 1.59, 0.93 and 0.60, i.e. variances of about 2.7, 0.89 and 0.36 when squared draw by draw).
# MCMCglmm
phylo_signal_mod1_mcmcglmm <- ((pool_chains(mod1_mcmcglmm, "VCV")[, "phylo"]) / (pool_chains(mod1_mcmcglmm, "VCV")[, "phylo"] + pool_chains(mod1_mcmcglmm, "VCV")[, "species"] + pool_chains(mod1_mcmcglmm, "VCV")[, "units"]))
phylo_signal_mod1_mcmcglmm %>% mean()
#> [1] 0.6636644
phylo_signal_mod1_mcmcglmm %>% quantile(probs = c(0.025,0.5,0.975))
#> 2.5% 50% 97.5%
#> 0.3480827 0.6839835 0.8749849
# brms
phylo_signal_mod1_brms <- mod1_brms %>% as_tibble() %>%
dplyr::select(Sigma_phy = sd_phylo__Intercept, Sigma_non_phy = sd_species__Intercept, Res = sigma) %>%
mutate(h2_gaussian = Sigma_phy^2 / (Sigma_phy^2 + Sigma_non_phy^2 + Res^2)) %>%
pull(h2_gaussian)
phylo_signal_mod1_brms %>% mean()
#> [1] 0.6488532
phylo_signal_mod1_brms %>% quantile(probs = c(0.025,0.5,0.975))
#> 2.5% 50% 97.5%
#> 0.3361122 0.6664383 0.8665302 The proportion of the total variance attributed to phylogeny was estimated as 0.66 (95% CI 0.35, 0.87) using MCMCglmm and 0.65 (0.34, 0.87) using brms, compared with about 0.72 implied by the simulation settings for this model (3.44 / (3.44 + 1 + 0.34)). With repeated observations per species, the variance can be decomposed further: the species random effect (species) represents among-species variation that is not explained by phylogeny, while the observation-level residual (units / sigma) represents within-species (observation-level) variation.
summarise_chains(mod1_mcmcglmm2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.6492 0.87530 -1.1360 2.3410 1.002 3891 3612
#> 2 mass 1.1870 0.06803 1.0530 1.3210 1.001 4279 4065
#> 3 phylo 2.9090 1.22700 0.9974 5.7630 1.001 3124 3754
#> 4 species 0.8229 0.24990 0.4077 1.3900 1.001 3395 3682
#> 5 units 0.2060 0.01492 0.1792 0.2374 1.000 3796 3917
posterior_summary(pool_chains(mod1_mcmcglmm2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.6491579 0.87533007 -1.136301 2.341200
#> mass 1.1870123 0.06803484 1.052997 1.320591
posterior_summary(pool_chains(mod1_mcmcglmm2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 2.9092444 1.22698737 0.9974151 5.7628715
#> species 0.8228845 0.24986257 0.4077050 1.3898469
#> units 0.2060390 0.01491852 0.1792353 0.2373614
summary(mod1_brms2)
#> Family: gaussian
#> Links: mu = identity
#> Formula: habitat_range ~ mass + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data1 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.64 0.35 0.97 2.35 1.00 1549 3168
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.90 0.14 0.64 1.18 1.00 1828 3329
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 0.69 0.82 -0.94 2.28 1.00 8845 5484
#> mass 1.19 0.07 1.05 1.32 1.00 13300 5353
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.45 0.02 0.42 0.49 1.00 7899 5795
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Next, in the model that includes log body mass, the slope of mass is 1.19 (95% CI 1.05, 1.32) in both packages, close to the true value of 1.2. Now that mass is in the model, the variance components are close to the values used in the simulation: in MCMCglmm, the phylogenetic variance is 2.91 (1.00, 5.76; true value 2), the species variance 0.82 (0.41, 1.39; true value 1) and the residual variance 0.206 (0.179, 0.237; true value 0.2).
summarise_chains(mod1_mcmcglmm3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.5555 0.90330 -1.18800 2.3330 1.000 4023 3972
#> 2 mass 1.1900 0.06854 1.05600 1.3220 1.000 3663 3723
#> 3 sexM 0.1059 0.04512 0.01748 0.1940 1.001 3893 3940
#> 4 phylo 2.9400 1.21400 1.03700 5.6860 1.001 3764 3776
#> 5 species 0.8145 0.24500 0.41730 1.3780 1.000 3887 3847
#> 6 units 0.2034 0.01475 0.17720 0.2355 0.999 4000 4119
posterior_summary(pool_chains(mod1_mcmcglmm3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.5554969 0.90325136 -1.18753492 2.3334630
#> mass 1.1899918 0.06853612 1.05574099 1.3223772
#> sexM 0.1058576 0.04511897 0.01747735 0.1939708
posterior_summary(pool_chains(mod1_mcmcglmm3, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 2.9402860 1.21364010 1.0372368 5.6861959
#> species 0.8145237 0.24498792 0.4172766 1.3780247
#> units 0.2033919 0.01475445 0.1771749 0.2355433
summary(mod1_brms3)
#> Family: gaussian
#> Links: mu = identity
#> Formula: habitat_range ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data1 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 1.62 0.36 0.96 2.36 1.00 1513 2701
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.91 0.13 0.65 1.18 1.00 2057 3765
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 0.63 0.83 -0.98 2.26 1.00 8128 5668
#> mass 1.19 0.07 1.05 1.33 1.00 13092 5394
#> sexM 0.10 0.04 0.02 0.19 1.00 13299 5669
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 0.45 0.02 0.42 0.48 1.00 7062 5793
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Finally, let’s take a look at the results when both mass and sex are included in the model. We assumed that the expected habitat range of males is 0.1 units larger than that of females, conditional on body mass. The estimates (0.106, 95% CI 0.017, 0.194 in MCMCglmm; 0.10, 0.02, 0.19 in brms) are consistent with this value, and the other estimates hardly change.
Binary
The response variable in this analysis is breeding success, defined as whether a species reproduced or not. The assumptions are as follows: phylogeny has a weak relationship with breeding success, while some non-phylogenetic factors, such as environmental conditions, are likely to play a role. Additionally, heavier species are assumed to have a higher likelihood of breeding success, and females (coded as 0) are expected to succeed in breeding more often than males.
# Code used to generate the canonical dataset (see data/simulated/generate_simulated_data.R).
# Phylogenetically structured values are drawn with u = L z, where L = t(chol(Sigma)).
## 2. Binary: breeding success (logit) ----------------------------------------------
seed <- 456
tree <- make_tree(seed, "binary")
A <- vcv(tree, corr = TRUE)
mu_species_mass <- rmvnorm_chol(rep(mu_mass, n_species), A)
obs_mass <- as.vector(sapply(mu_species_mass, function(x) rnorm(obs_per_species, mean = x, sd = sqrt(0.2))))
sex <- rbinom(n, 1, 0.5)
var_phylo <- 0.4; var_non <- 0.3
beta <- c(intercept = -0.5, mass = 0.4, sexM = -1.5)
u_phylo <- rmvnorm_chol(rep(0, n_species), var_phylo * A)
u_non <- rnorm(n_species, sd = sqrt(var_non)) # one value per species
species <- rep(tree$tip.label, each = obs_per_species)
eta <- beta[["intercept"]] + beta[["mass"]] * obs_mass + beta[["sexM"]] * sex +
rep(u_phylo, each = obs_per_species) + rep(u_non, each = obs_per_species)
y <- rbinom(n, 1, plogis(eta))
save_sim("binary",
data.frame(individual_id = 1:n, species = species, phylo = species, breeding = y,
mass = obs_mass, sex = factor(sex, levels = 0:1, labels = c("F", "M"))),
data.frame(species = tree$tip.label, phylo_effect = u_phylo, non_phylo_effect = u_non),
list(seed = seed, n_species = n_species, obs_per_species = obs_per_species, link = "logit",
beta = as.list(beta), var_phylo = var_phylo, var_species = var_non,
mass = list(mean = mu_mass, var_among_species = 1, var_within_species = 0.2)))The simulated dataset, the tree, the simulated species-level effects and the true parameter values are saved in data/simulated/. We use these saved files (rather than re-running the simulation) for fitting and for this tutorial:
sim_binary <- read_simulated_data("binary")
sim_data2 <- sim_binary$data
tree2 <- sim_binary$tree
head(sim_data2) individual_id species phylo breeding mass sex
1 1 t97 t97 0 4.147570 M
2 2 t97 t97 0 5.194576 F
3 3 t97 t97 1 4.300113 F
4 4 t97 t97 0 3.941728 F
5 5 t97 t97 0 3.933581 M
6 6 t98 t98 1 4.240386 FRun models
# MCMCglmm
inv_phylo <- inverseA(tree2, nodes = "ALL", scale = TRUE)
prior2_mcmcglmm <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10),
G2 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mod2_mcmcglmm_logit <- run_mcmcglmm_chains(breeding ~ 1,
random = ~ phylo + species,
family = "categorical",
data = sim_data2,
prior = prior2_mcmcglmm,
ginverse = list(phylo = inv_phylo$Ainv),
seeds = c(20267526, 20267527, 20267528, 20267529), # one seed per chain (four chains)
nitt = 13000*10,
thin = 10*10,
burnin = 3000*10)
)
system.time(
mod2_mcmcglmm_logit2 <- run_mcmcglmm_chains(breeding ~ mass,
random = ~ phylo + species,
family = "categorical",
data = sim_data2,
prior = prior2_mcmcglmm,
ginverse = list(phylo = inv_phylo$Ainv),
seeds = c(20267626, 20267627, 20267628, 20267629), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20)
)
system.time(
mod2_mcmcglmm_logit3 <- run_mcmcglmm_chains(breeding ~ mass + sex,
random = ~ phylo + species,
family = "categorical",
data = sim_data2,
prior = prior2_mcmcglmm,
ginverse = list(phylo = inv_phylo$Ainv),
seeds = c(20267726, 20267727, 20267728, 20267729), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20)
)
# brms
A <- ape::vcv.phylo(tree2, corr = TRUE)
priors2_brms <- default_prior(
breeding ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit")
)
system.time(
mod2_brms_logit <- brm(breeding ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors2_brms,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20270426,
control = list(adapt_delta = 0.999)
)
)
priors2_brms2 <- default_prior(
breeding ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit")
)
system.time(
mod2_brms_logit2 <- brm(breeding ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors2_brms2,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20269526,
control = list(adapt_delta = 0.99)
)
)
priors2_brms3 <- default_prior(
breeding ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit")
)
system.time(
mod2_brms_logit3 <- brm(breeding ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data2,
data2 = list(A = A),
family = bernoulli(link = "logit"),
prior = priors2_brms3,
iter = 8000,
warmup = 6000,
thin = 1,
chains = 4,
cores = 4,
seed = 20269626,
control = list(adapt_delta = 0.99)
)
)Results
True values are here:
sim_binary$params # seed and true parameter values used to generate the data$seed
[1] 456
$n_species
[1] 100
$obs_per_species
[1] 5
$link
[1] "logit"
$beta
$beta$intercept
[1] -0.5
$beta$mass
[1] 0.4
$beta$sexM
[1] -1.5
$var_phylo
[1] 0.4
$var_species
[1] 0.3
$mass
$mass$mean
[1] 4.60517
$mass$var_among_species
[1] 1
$mass$var_within_species
[1] 0.2# realised variances of the simulated species-level effects (for reference only: these are
# sample variances across phylogenetically correlated species, not the model's estimands)
sapply(sim_binary$effects[-1], var) phylo_effect non_phylo_effect
0.2462704 0.2817466 Before checking the output, we need to correct the results from MCMCglmm using the following equation:
c2 <- (16 * sqrt(3) / (15 * pi))^2summarise_chains(mod2_mcmcglmm_logit)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.1714 0.2883 -0.3895000 0.787 1.000 4079 3637
#> 2 phylo 0.2487 0.3403 0.0003167 1.176 1.000 3398 3558
#> 3 species 0.6603 0.3737 0.0508000 1.525 1.002 2786 3451
#> 4 units 1.0000 0.0000 1.0000000 1.000 NA NA NA
# c2-corrected estimates (logit model with the residual variance fixed at 1)
posterior_summary(pool_chains(mod2_mcmcglmm_logit, "Sol") / sqrt(1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.1477881 0.2485321 -0.3357053 0.6783537
posterior_summary(pool_chains(mod2_mcmcglmm_logit, "VCV") / (1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.1847717 0.2528659 0.0002353433 0.8736034
#> species 0.4905952 0.2776548 0.0377472310 1.1330256
#> units 0.7430287 0.0000000 0.7430287334 0.7430287
summary(mod2_brms_logit)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: breeding ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data2 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.34 0.24 0.02 0.91 1.00 1402 2764
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.66 0.20 0.23 1.04 1.00 1808 1641
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept 0.15 0.24 -0.30 0.67 1.00 4540 3778
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).This intercept-only model omits mass and sex, so its intercept (c2-corrected MCMCglmm: 0.15, 95% CI −0.34, 0.68; brms: 0.15, −0.30, 0.67) is not comparable with the true intercept (−0.5, for females with a log body mass of 0). The phylogenetic variance is estimated to be small and very uncertain (c2-corrected MCMCglmm: 0.18, 95% CI 0.00, 0.87; true value 0.4), and the species variance is 0.49 (0.04, 1.13; true value 0.3). With 100 species and binary observations, the data contain little information to separate the phylogenetic and the non-phylogenetic species variance.
And phylogenetic signal is…
# phylogenetic variance proportion on the latent logit scale:
# sigma2_phylo / (sigma2_phylo + sigma2_species + pi^2/3), calculated for each draw
## MCMCglmm: c2-corrected variances
VCV <- pool_chains(mod2_mcmcglmm_logit, "VCV") / (1 + c2)
posterior_summary(VCV[, "phylo"] / (VCV[, "phylo"] + VCV[, "species"] + pi^2 / 3))
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.04400099 0.05408224 6.007242e-05 0.1935107
## brms
draws <- as_draws_df(mod2_brms_logit)
posterior_summary(with(draws, sd_phylo__Intercept^2 / (sd_phylo__Intercept^2 + sd_species__Intercept^2 + pi^2 / 3)))
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.04213701 0.05083829 8.298749e-05 0.1810616
# value implied by the simulation settings (variances 0.4 and 0.3)
0.4 / (0.4 + 0.3 + pi^2 / 3)
#> [1] 0.1002539The phylogenetic variance proportion is 0.04 (95% CI 0.00, 0.19) in MCMCglmm and 0.04 (0.00, 0.18) in brms. It is lower than the value of 0.10 computed from the simulation parameters, but its 95% CI includes that value; the estimate is very imprecise.
summarise_chains(mod2_mcmcglmm_logit2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -3.0660 0.8710 -4.8060000 -1.4040 1 4060 3955
#> 2 mass 0.7476 0.1935 0.3741000 1.1430 1 4064 3661
#> 3 phylo 0.1790 0.2686 0.0001957 0.9325 1 3954 3718
#> 4 species 0.6185 0.3575 0.0453200 1.4270 1 3698 3720
#> 5 units 1.0000 0.0000 1.0000000 1.0000 NA NA NA
# c2-corrected estimates (logit model with the residual variance fixed at 1)
posterior_summary(pool_chains(mod2_mcmcglmm_logit2, "Sol") / sqrt(1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -2.6424724 0.7507854 -4.1428362 -1.2103611
#> mass 0.6444592 0.1668177 0.3224617 0.9856797
posterior_summary(pool_chains(mod2_mcmcglmm_logit2, "VCV") / (1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.1329656 0.1995897 0.0001453904 0.6928691
#> species 0.4595888 0.2656326 0.0336717109 1.0603366
#> units 0.7430287 0.0000000 0.7430287334 0.7430287
summary(mod2_brms_logit2)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: breeding ~ mass + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data2 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.28 0.21 0.01 0.80 1.00 2098 3751
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.62 0.22 0.13 1.01 1.00 1461 1087
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -2.58 0.75 -4.09 -1.18 1.00 8511 6001
#> mass 0.63 0.17 0.32 0.97 1.00 9123 5808
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).summarise_chains(mod2_mcmcglmm_logit3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) -2.2560 0.9425 -4.1550000 -0.4386 1.000 3978 4015
#> 2 mass 0.7611 0.2085 0.3563000 1.1880 0.999 4025 4058
#> 3 sexM -1.6290 0.2615 -2.1590000 -1.1290 1.000 3682 3894
#> 4 phylo 0.1877 0.2938 0.0002213 1.0630 1.000 3780 3745
#> 5 species 0.8405 0.4270 0.1369000 1.8160 1.000 3502 3770
#> 6 units 1.0000 0.0000 1.0000000 1.0000 NA NA NA
# c2-corrected estimates (logit model with the residual variance fixed at 1)
posterior_summary(pool_chains(mod2_mcmcglmm_logit3, "Sol") / sqrt(1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) -1.9448453 0.8123957 -3.5818590 -0.3780742
#> mass 0.6560736 0.1797595 0.3071429 1.0242838
#> sexM -1.4039239 0.2254451 -1.8612162 -0.9727763
posterior_summary(pool_chains(mod2_mcmcglmm_logit3, "VCV") / (1 + c2))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.1394553 0.2183029 0.0001644348 0.7896023
#> species 0.6245436 0.3172362 0.1017075569 1.3495600
#> units 0.7430287 0.0000000 0.7430287334 0.7430287
summary(mod2_brms_logit3)
#> Family: bernoulli
#> Links: mu = logit
#> Formula: breeding ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data2 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 8000; warmup = 6000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.29 0.23 0.01 0.85 1.00 1813 3221
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.75 0.20 0.34 1.15 1.00 1930 1746
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept -1.92 0.78 -3.50 -0.40 1.00 8929 5985
#> mass 0.65 0.17 0.32 1.00 1.00 9010 6230
#> sexM -1.38 0.22 -1.81 -0.96 1.00 10647 5823
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).In the full model, the sex effect is recovered well (c2-corrected MCMCglmm: −1.40, 95% CI −1.86, −0.97; brms: −1.38, −1.81, −0.96; true value −1.5). The slope of mass is estimated to be steeper than the true value of 0.4 (0.66, 95% CI 0.31, 1.02 and 0.65, 0.32, 1.00), although the 95% CIs include it. Because the intercept refers to a log body mass of 0, far outside the range of the data (mean log mass ≈ 4.3), it compensates for the steeper slope, and its 95% CI (−3.58, −0.38 in MCMCglmm) does not include the true value of −0.5. A single simulated dataset shows how the estimates behave for one realisation only; bias can be assessed only with many simulated datasets.
Ordinal
The response variable is the aggressiveness level, which has three categories: Low, Medium, and High. It is assumed that phylogeny plays a substantial role in aggressiveness. However, non-phylogenetic factors are expected to have only a weak relationship with aggressiveness. The relationship between body mass and aggressiveness is unclear, and it may vary across species. Additionally, males are more likely to exhibit higher levels of aggressiveness compared to females.
# Code used to generate the canonical dataset (see data/simulated/generate_simulated_data.R).
# Phylogenetically structured values are drawn with u = L z, where L = t(chol(Sigma)).
## 3. Ordinal: aggressiveness (probit) ----------------------------------------------
seed <- 789
tree <- make_tree(seed, "ordinal")
A <- vcv(tree, corr = TRUE)
mu_species_mass <- rmvnorm_chol(rep(mu_mass, n_species), A)
obs_mass <- as.vector(sapply(mu_species_mass, function(x) rnorm(obs_per_species, mean = x, sd = sqrt(0.2))))
sex <- rbinom(n, 1, 0.5)
var_phylo <- 1; var_non <- 0.4
beta <- c(intercept = -0.5, mass = 0, sexM = 1)
cutpoints <- c(-0.5, 0.5)
u_phylo <- rmvnorm_chol(rep(0, n_species), var_phylo * A)
u_non <- rnorm(n_species, sd = sqrt(var_non))
species <- rep(tree$tip.label, each = obs_per_species)
eta <- beta[["intercept"]] + beta[["mass"]] * obs_mass + beta[["sexM"]] * sex +
rep(u_phylo, each = obs_per_species) + rep(u_non, each = obs_per_species)
probs <- cbind(pnorm(cutpoints[1] - eta), pnorm(cutpoints[2] - eta) - pnorm(cutpoints[1] - eta), 1 - pnorm(cutpoints[2] - eta))
y <- apply(probs, 1, function(p) sample(1:3, 1, prob = p))
save_sim("ordinal",
data.frame(individual_id = 1:n, species = species, phylo = species,
aggressive_level = factor(y, levels = 1:3, labels = c("Low", "Medium", "High")),
mass = obs_mass, sex = factor(sex, levels = 0:1, labels = c("F", "M"))),
data.frame(species = tree$tip.label, phylo_effect = u_phylo, non_phylo_effect = u_non),
list(seed = seed, n_species = n_species, obs_per_species = obs_per_species, link = "probit",
beta = as.list(beta), cutpoints = cutpoints, var_phylo = var_phylo, var_species = var_non,
mass = list(mean = mu_mass, var_among_species = 1, var_within_species = 0.2)))The simulated dataset, the tree, the simulated species-level effects and the true parameter values are saved in data/simulated/. We use these saved files (rather than re-running the simulation) for fitting and for this tutorial:
sim_ordinal <- read_simulated_data("ordinal")
sim_data3 <- sim_ordinal$data
tree3 <- sim_ordinal$tree
head(sim_data3) individual_id species phylo aggressive_level mass sex
1 1 t39 t39 High 5.413890 M
2 2 t39 t39 High 6.717631 M
3 3 t39 t39 Medium 6.222828 F
4 4 t39 t39 High 6.029930 M
5 5 t39 t39 Medium 6.332717 F
6 6 t40 t40 Medium 6.464850 FRun models
# mcmcglmm
inv_phylo <- inverseA(tree3, nodes = "ALL", scale = TRUE)
prior1 <- list(R = list(V = 1, fix = 1),
G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10),
G2 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 10)
)
)
system.time(
mod3_mcmcglmm <- run_mcmcglmm_chains(aggressive_level ~ 1,
random = ~ phylo + species,
ginverse = list(phylo = inv_phylo$Ainv),
family = "threshold",
data = sim_data3,
prior = prior1,
seeds = c(20268126, 20268127, 20268128, 20268129), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20
)
)
system.time(
mod3_mcmcglmm2 <- run_mcmcglmm_chains(aggressive_level ~ mass,
random = ~ phylo + species,
ginverse = list(phylo = inv_phylo$Ainv),
family = "threshold",
data = sim_data3,
prior = prior1,
seeds = c(20268226, 20268227, 20268228, 20268229), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20
)
)
system.time(
mod3_mcmcglmm3 <- run_mcmcglmm_chains(aggressive_level ~ mass + sex,
random = ~ phylo + species,
ginverse = list(phylo = inv_phylo$Ainv),
family = "threshold",
data = sim_data3,
prior = prior1,
seeds = c(20268326, 20268327, 20268328, 20268329), # one seed per chain (four chains)
nitt = 13000*20,
thin = 10*20,
burnin = 3000*20
)
)
# brms
A <- ape::vcv.phylo(tree3, corr = TRUE)
default_priors <- default_prior(
aggressive_level ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
system.time(
mod3_brms <- brm(
formula = aggressive_level ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors,
iter = 9000,
warmup = 7000,
thin = 1,
chains = 4,
cores = 4,
seed = 20268426,
control = list(adapt_delta = 0.95)
)
)
default_priors2 <- default_prior(
aggressive_level ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
system.time(
mod3_brms2 <- brm(
formula = aggressive_level ~ mass + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors2,
iter = 9000,
warmup = 7000,
thin = 1,
chains = 4,
cores = 4,
seed = 20268526,
control = list(adapt_delta = 0.95)
)
)
default_priors3 <- default_prior(
aggressive_level ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A)
)
system.time(
mod3_brms3 <- brm(
formula = aggressive_level ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species),
data = sim_data3,
family = cumulative(link = "probit"),
data2 = list(A = A),
prior = default_priors3,
iter = 9000,
warmup = 7000,
thin = 1,
chains = 4,
cores = 4,
seed = 20268626,
control = list(adapt_delta = 0.95)
)
)Results
The estimates should align with the following values…
sim_ordinal$params # seed and true parameter values used to generate the data$seed
[1] 789
$n_species
[1] 100
$obs_per_species
[1] 5
$link
[1] "probit"
$beta
$beta$intercept
[1] -0.5
$beta$mass
[1] 0
$beta$sexM
[1] 1
$cutpoints
[1] -0.5 0.5
$var_phylo
[1] 1
$var_species
[1] 0.4
$mass
$mass$mean
[1] 4.60517
$mass$var_among_species
[1] 1
$mass$var_within_species
[1] 0.2# realised variances of the simulated species-level effects (for reference only: these are
# sample variances across phylogenetically correlated species, not the model's estimands)
sapply(sim_ordinal$effects[-1], var) phylo_effect non_phylo_effect
0.6146812 0.3352239 summarise_chains(mod3_mcmcglmm)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 1.1380 0.32390 0.54820 1.8590 1.002 3872 3886
#> 2 phylo 0.5243 0.39380 0.04160 1.5170 1.001 3783 3676
#> 3 species 0.3898 0.18390 0.06292 0.7950 1.001 4175 3814
#> 4 units 1.0000 0.00000 1.00000 1.0000 NA NA NA
#> 5 cutpoint.traitaggressive_level.1 0.8021 0.06999 0.67100 0.9435 1.000 3967 4098
posterior_summary(pool_chains(mod3_mcmcglmm, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 1.137618 0.3239239 0.5481601 1.859035
posterior_summary(pool_chains(mod3_mcmcglmm, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.5242751 0.3938244 0.04160262 1.5169436
#> species 0.3897617 0.1839424 0.06291609 0.7949855
#> units 1.0000000 0.0000000 1.00000000 1.0000000
posterior_summary(pool_chains(mod3_mcmcglmm, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitaggressive_level.1 0.8020519 0.06998891 0.6709984 0.9435266
summary(mod3_brms)
#> Family: cumulative
#> Links: mu = probit
#> Formula: aggressive_level ~ 1 + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data3 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 9000; warmup = 7000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.66 0.25 0.21 1.20 1.01 728 1714
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.61 0.14 0.31 0.88 1.00 1040 1765
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -1.10 0.30 -1.74 -0.54 1.00 4233 4091
#> Intercept[2] -0.30 0.30 -0.93 0.26 1.00 4327 4208
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The two packages agree, and the four chains of each model converged. This intercept-only model omits the sex effect, so its intercept and cutpoint are not directly comparable with the true values. The phylogenetic variance (MCMCglmm: 0.52, 95% CI 0.04, 1.52) and the species variance (0.39, 0.06, 0.79) are consistent with the true values of 1 and 0.4. The proportion of the latent-scale variance attributed to phylogeny is…
# MCMCglmm
phylo_signal_mod3_mcmcglmm <- ((pool_chains(mod3_mcmcglmm, "VCV")[, "phylo"]) / (pool_chains(mod3_mcmcglmm, "VCV")[, "phylo"] + pool_chains(mod3_mcmcglmm, "VCV")[, "species"] + 1))
phylo_signal_mod3_mcmcglmm %>% mean()
#> [1] 0.2540334
phylo_signal_mod3_mcmcglmm %>% quantile(probs = c(0.025,0.5,0.975))
#> 2.5% 50% 97.5%
#> 0.02521306 0.23818158 0.56177752
# brms
phylo_signal_mod3_brms <- mod3_brms %>% as_tibble() %>%
dplyr::select(Sigma_phy = sd_phylo__Intercept, Sigma_non_phy = sd_species__Intercept) %>%
mutate(h2_ordinal = Sigma_phy^2 / (Sigma_phy^2 + Sigma_non_phy^2 +1)) %>%
pull(h2_ordinal)
phylo_signal_mod3_brms %>% mean()
#> [1] 0.2452954
phylo_signal_mod3_brms %>% quantile(probs = c(0.025,0.5,0.975))
#> 2.5% 50% 97.5%
#> 0.02596721 0.22827043 0.54072770 The two packages yielded nearly identical phylogenetic variance proportions (0.25, 95% CI 0.03, 0.56 in MCMCglmm; 0.25, 0.03, 0.54 in brms), compared with 1 / (1 + 0.4 + 1) ≈ 0.42 implied by the simulation settings. The estimates are imprecise, and the 95% CIs include this value.
summarise_chains(mod3_mcmcglmm2)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.92620 0.58620 -0.20040 2.1270 1 4097 4098
#> 2 mass 0.04098 0.10000 -0.15650 0.2367 1 4092 4101
#> 3 phylo 0.55100 0.39430 0.04274 1.5900 1 3883 3847
#> 4 species 0.39240 0.18290 0.07784 0.7994 1 3823 3766
#> 5 units 1.00000 0.00000 1.00000 1.0000 NA NA NA
#> 6 cutpoint.traitaggressive_level.1 0.80210 0.07054 0.66940 0.9455 1 3769 3772
posterior_summary(pool_chains(mod3_mcmcglmm2, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.92617683 0.58624724 -0.2003995 2.1273916
#> mass 0.04098364 0.09999687 -0.1564994 0.2367123
posterior_summary(pool_chains(mod3_mcmcglmm2, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.5510121 0.3942541 0.04273544 1.5903447
#> species 0.3924480 0.1828755 0.07784035 0.7993512
#> units 1.0000000 0.0000000 1.00000000 1.0000000
posterior_summary(pool_chains(mod3_mcmcglmm2, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitaggressive_level.1 0.8021423 0.07054358 0.6694244 0.9455287
summary(mod3_brms2)
#> Family: cumulative
#> Links: mu = probit
#> Formula: aggressive_level ~ mass + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data3 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 9000; warmup = 7000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.72 0.27 0.25 1.29 1.00 775 1608
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.60 0.16 0.25 0.89 1.00 894 902
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -0.90 0.58 -2.05 0.22 1.00 6184 4905
#> Intercept[2] -0.10 0.58 -1.24 1.04 1.00 6136 4796
#> mass 0.04 0.10 -0.15 0.24 1.00 8678 6072
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
summarise_chains(mod3_mcmcglmm3)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 (Intercept) 0.2333 0.64920 -1.03800 1.513 1.000 3992 3933
#> 2 mass 0.1091 0.10960 -0.10730 0.322 1.000 3944 3914
#> 3 sexM 1.1830 0.13620 0.92470 1.458 1.000 3869 3656
#> 4 phylo 0.7907 0.55550 0.08275 2.148 1.000 3796 3766
#> 5 species 0.5987 0.25520 0.16760 1.161 1.000 3989 3739
#> 6 units 1.0000 0.00000 1.00000 1.000 NA NA NA
#> 7 cutpoint.traitaggressive_level.1 0.9494 0.08197 0.79510 1.119 1.002 3730 3374
posterior_summary(pool_chains(mod3_mcmcglmm3, "Sol"))
#> Estimate Est.Error Q2.5 Q97.5
#> (Intercept) 0.2333177 0.6491678 -1.0381977 1.513157
#> mass 0.1090975 0.1095780 -0.1073054 0.322027
#> sexM 1.1834417 0.1362275 0.9247171 1.458295
posterior_summary(pool_chains(mod3_mcmcglmm3, "VCV"))
#> Estimate Est.Error Q2.5 Q97.5
#> phylo 0.7906601 0.5555310 0.08275195 2.147999
#> species 0.5986651 0.2552422 0.16759208 1.161434
#> units 1.0000000 0.0000000 1.00000000 1.000000
posterior_summary(pool_chains(mod3_mcmcglmm3, "CP"))
#> Estimate Est.Error Q2.5 Q97.5
#> cutpoint.traitaggressive_level.1 0.9494176 0.08197301 0.7950599 1.11937
summary(mod3_brms3)
#> Family: cumulative
#> Links: mu = probit
#> Formula: aggressive_level ~ mass + sex + (1 | gr(phylo, cov = A)) + (1 | species)
#> Data: sim_data3 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 9000; warmup = 7000; thin = 1;
#> total post-warmup draws = 8000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.83 0.30 0.28 1.47 1.00 935 1689
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(Intercept) 0.76 0.17 0.41 1.08 1.00 1266 2155
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept[1] -0.19 0.64 -1.45 1.04 1.00 8766 6370
#> Intercept[2] 0.75 0.65 -0.51 2.00 1.00 8632 6266
#> mass 0.11 0.11 -0.10 0.33 1.00 10302 6625
#> sexM 1.18 0.13 0.92 1.45 1.00 11734 6150
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> disc 1.00 0.00 1.00 1.00 NA NA NA
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).Both MCMCglmm and brms estimated very similar values. In the full model, the sex effect (1.18, 95% CI 0.92, 1.46 in MCMCglmm; 1.18, 0.92, 1.45 in brms) and the mass effect (0.11, −0.11, 0.32; true value 0) are consistent with the values set in the simulation. The same holds for the second cutpoint of MCMCglmm (0.95, 0.80, 1.12; true value 1, the distance between the two thresholds), the phylogenetic variance (0.79, 0.08, 2.15; true value 1) and the species variance (0.60, 0.17, 1.16; true value 0.4).
Nominal
The response variable is lateralisation (handedness/footedness), categorised as Left, Right, or Both, with “Both” serving as the reference category, representing no preference. The majority of individuals show a preference for either the left or the right side, with only a few exhibiting no clear preference.
Here, we create a simple dataset and fit only the intercept-only model. The nominal model is more complex, and with the sample size used above (100 species × 5 observations), variances and correlations were not recovered well when we included more effects. We therefore do not include effects of mass or sex in the linear predictor (the simulated data contain mass and sex columns only for consistency with the other datasets). Both the phylogenetic and the non-phylogenetic correlations between Left and Right are set to zero.
# Code used to generate the canonical dataset (see data/simulated/generate_simulated_data.R).
# Phylogenetically structured values are drawn with u = L z, where L = t(chol(Sigma)).
## 4. Nominal: lateralisation (multinomial logit, reference = Both) -------------------
seed <- 789
tree <- make_tree(seed, "nominal")
A <- vcv(tree, corr = TRUE)
sd_phylo <- c(Left = 1, Right = 1.5); cor_phylo <- 0
sd_species <- c(Left = 1.1, Right = 1); cor_species <- 0
cov_phylo <- diag(sd_phylo^2); cov_phylo[1, 2] <- cov_phylo[2, 1] <- cor_phylo * prod(sd_phylo)
cov_species <- diag(sd_species^2); cov_species[1, 2] <- cov_species[2, 1] <- cor_species * prod(sd_species)
beta0 <- c(Left = 0.4, Right = 0.8) # intercepts relative to Both; no mass or sex effects
u_phylo <- matrix(rmvnorm_chol(rep(0, 2 * n_species), kronecker(cov_phylo, A)), ncol = 2)
L_species <- t(chol(cov_species))
u_species <- t(L_species %*% matrix(rnorm(2 * n_species), nrow = 2))
eta <- cbind(beta0[["Left"]] + rep(u_phylo[, 1], each = obs_per_species) + rep(u_species[, 1], each = obs_per_species),
beta0[["Right"]] + rep(u_phylo[, 2], each = obs_per_species) + rep(u_species[, 2], each = obs_per_species))
probs <- exp(cbind(eta, 0)); probs <- probs / rowSums(probs)
y <- apply(probs, 1, function(p) sample(1:3, 1, prob = p))
# mass and sex are generated after the response and do not affect it
mu_species_mass <- rmvnorm_chol(rep(mu_mass, n_species), A)
obs_mass <- as.vector(sapply(mu_species_mass, function(x) rnorm(obs_per_species, mean = x, sd = sqrt(0.2))))
sex <- rbinom(n, 1, 0.5)
species <- rep(tree$tip.label, each = obs_per_species)
lat <- factor(c("Left", "Right", "Both")[y], levels = c("Both", "Left", "Right"))
save_sim("nominal",
data.frame(individual_id = 1:n, species = species, phylo = species, lateralisation = lat,
mass = obs_mass, sex = factor(sex, levels = 0:1, labels = c("F", "M"))),
data.frame(species = tree$tip.label, phylo_effect_left = u_phylo[, 1], phylo_effect_right = u_phylo[, 2],
species_effect_left = u_species[, 1], species_effect_right = u_species[, 2]),
list(seed = seed, n_species = n_species, obs_per_species = obs_per_species, link = "multinomial logit",
reference = "Both", intercepts = as.list(beta0), sd_phylo = as.list(sd_phylo), cor_phylo = cor_phylo,
sd_species = as.list(sd_species), cor_species = cor_species))The simulated dataset, the tree, the simulated species-level effects and the true parameter values are saved in data/simulated/. We use these saved files (rather than re-running the simulation) for fitting and for this tutorial:
sim_nominal <- read_simulated_data("nominal")
sim_data4 <- sim_nominal$data
tree4 <- sim_nominal$tree
head(sim_data4) individual_id species phylo lateralisation mass sex
1 1 t39 t39 Right 4.835986 M
2 2 t39 t39 Left 4.885954 F
3 3 t39 t39 Left 5.590923 F
4 4 t39 t39 Left 6.680875 F
5 5 t39 t39 Left 4.927750 F
6 6 t40 t40 Left 5.328664 FRun models
inv_phylo <- inverseA(tree4, nodes = "ALL", scale = TRUE)
prior1 <- list(
R = list(V = (matrix(1, 2, 2) + diag(2)) / 3, fix = 1),
G = list(G1 = list(V = diag(2), nu = 2,
alpha.mu = rep(0, 2), alpha.V = diag(2)
),
G2 = list(V = diag(2), nu = 2,
alpha.mu = rep(0, 2), alpha.V = diag(2)
)
)
)
system.time(
mod4_mcmcglmm <- run_mcmcglmm_chains(lateralisation ~ trait - 1,
random = ~us(trait):phylo + us(trait):species,
rcov = ~us(trait):units,
ginverse = list(phylo = inv_phylo$Ainv),
family = "categorical",
data = sim_data4,
prior = prior1,
seeds = c(20268726, 20268727, 20268728, 20268729), # one seed per chain (four chains)
nitt = 13000*150,
thin = 10*150,
burnin = 3000*150
)
)
# brms
A <- ape::vcv.phylo(tree4, corr = TRUE)
priors_brms1 <- default_prior(lateralisation ~ 1 + (1 |a| gr(phylo, cov = A)) + (1 |b| species),
data = sim_data4,
data2 = list(A = A),
family = categorical(link = "logit")
)
system.time(
mod4_brms <- brm(lateralisation ~ 1 + (1 |a| gr(phylo, cov = A)) + (1 |b| species),
data = sim_data4,
data2 = list(A = A),
family = categorical(link = "logit"),
prior = priors_brms1,
iter = 12000,
warmup = 8000,
chains = 4,
cores = 4,
seed = 20268826,
thin = 1,
control = list(adapt_delta = 0.99)
)
)Results
True values are…
sim_nominal$params # seed and true parameter values used to generate the data$seed
[1] 789
$n_species
[1] 100
$obs_per_species
[1] 5
$link
[1] "multinomial logit"
$reference
[1] "Both"
$intercepts
$intercepts$Left
[1] 0.4
$intercepts$Right
[1] 0.8
$sd_phylo
$sd_phylo$Left
[1] 1
$sd_phylo$Right
[1] 1.5
$cor_phylo
[1] 0
$sd_species
$sd_species$Left
[1] 1.1
$sd_species$Right
[1] 1
$cor_species
[1] 0# realised variances of the simulated species-level effects (for reference only: these are
# sample variances across phylogenetically correlated species, not the model's estimands)
sapply(sim_nominal$effects[-1], var) phylo_effect_left phylo_effect_right species_effect_left
1.018585 1.681170 1.357229
species_effect_right
1.010172 Before checking the output, we need to correct the results from MCMCglmm using the following equation:
c2 <- (16 * sqrt(3) / (15 * pi))^2
c2a <- c2*(2/3)summarise_chains(mod4_mcmcglmm)
#> parameter mean sd Q2.5 Q97.5 rhat ess_bulk ess_tail
#> 1 traitlateralisation.Left 0.4472 0.8167 -1.1290 2.1510 1.000 3777 4016
#> 2 traitlateralisation.Right 0.5272 0.7786 -1.0960 1.9860 1.000 3313 3626
#> 3 traitlateralisation.Left:traitlateralisation.Left.phylo 3.6760 2.2710 0.8002 9.3580 1.000 3457 3300
#> 4 traitlateralisation.Right:traitlateralisation.Left.phylo -0.8510 1.4450 -3.7150 2.1540 1.001 3099 3787
#> 5 traitlateralisation.Left:traitlateralisation.Right.phylo -0.8510 1.4450 -3.7150 2.1540 1.001 3099 3787
#> 6 traitlateralisation.Right:traitlateralisation.Right.phylo 3.1880 2.3190 0.3155 9.1600 1.000 3394 3871
#> 7 traitlateralisation.Left:traitlateralisation.Left.species 1.8780 1.2620 0.1173 5.0080 1.000 2904 3682
#> 8 traitlateralisation.Right:traitlateralisation.Left.species -0.1705 0.7759 -1.5710 1.6440 1.000 3604 3363
#> 9 traitlateralisation.Left:traitlateralisation.Right.species -0.1705 0.7759 -1.5710 1.6440 1.000 3604 3363
#> 10 traitlateralisation.Right:traitlateralisation.Right.species 2.1910 1.2550 0.2598 5.1280 1.000 3429 3664
#> 11 traitlateralisation.Left:traitlateralisation.Left.units 0.6667 0.0000 0.6667 0.6667 NA NA NA
#> 12 traitlateralisation.Right:traitlateralisation.Left.units 0.3333 0.0000 0.3333 0.3333 NA NA NA
#> 13 traitlateralisation.Left:traitlateralisation.Right.units 0.3333 0.0000 0.3333 0.3333 NA NA NA
#> 14 traitlateralisation.Right:traitlateralisation.Right.units 0.6667 0.0000 0.6667 0.6667 NA NA NA
# c2-corrected estimates (K = 3 categories, so c2a = c2 * 2/3)
res_1 <- pool_chains(mod4_mcmcglmm, "Sol") / sqrt(1 + c2a) # fixed effects
res_2 <- pool_chains(mod4_mcmcglmm, "VCV") / (1 + c2a) # (co)variances
posterior_summary(res_1)
#> Estimate Est.Error Q2.5 Q97.5
#> traitlateralisation.Left 0.4031275 0.7362030 -1.0175797 1.938696
#> traitlateralisation.Right 0.4752124 0.7018534 -0.9880464 1.790223
posterior_summary(res_2)
#> Estimate Est.Error Q2.5 Q97.5
#> traitlateralisation.Left:traitlateralisation.Left.phylo 2.9873267 1.8458033 0.65028683 7.6043507
#> traitlateralisation.Right:traitlateralisation.Left.phylo -0.6915935 1.1746599 -3.01870132 1.7507496
#> traitlateralisation.Left:traitlateralisation.Right.phylo -0.6915935 1.1746599 -3.01870132 1.7507496
#> traitlateralisation.Right:traitlateralisation.Right.phylo 2.5903444 1.8844413 0.25642202 7.4439733
#> traitlateralisation.Left:traitlateralisation.Left.species 1.5265349 1.0259124 0.09534705 4.0700028
#> traitlateralisation.Right:traitlateralisation.Left.species -0.1385879 0.6305619 -1.27693543 1.3357064
#> traitlateralisation.Left:traitlateralisation.Right.species -0.1385879 0.6305619 -1.27693543 1.3357064
#> traitlateralisation.Right:traitlateralisation.Right.species 1.7807773 1.0198215 0.21111802 4.1675122
#> traitlateralisation.Left:traitlateralisation.Left.units 0.5417579 0.0000000 0.54175789 0.5417579
#> traitlateralisation.Right:traitlateralisation.Left.units 0.2708789 0.0000000 0.27087895 0.2708789
#> traitlateralisation.Left:traitlateralisation.Right.units 0.2708789 0.0000000 0.27087895 0.2708789
#> traitlateralisation.Right:traitlateralisation.Right.units 0.5417579 0.0000000 0.54175789 0.5417579
# phylogenetic and species-level (non-phylogenetic) correlations between the two contrasts,
# calculated for each posterior draw (not changed by the c2 correction)
VCV <- pool_chains(mod4_mcmcglmm, "VCV")
corr_phylo <- VCV[, "traitlateralisation.Right:traitlateralisation.Left.phylo"] /
sqrt(VCV[, "traitlateralisation.Left:traitlateralisation.Left.phylo"] *
VCV[, "traitlateralisation.Right:traitlateralisation.Right.phylo"])
corr_species <- VCV[, "traitlateralisation.Right:traitlateralisation.Left.species"] /
sqrt(VCV[, "traitlateralisation.Left:traitlateralisation.Left.species"] *
VCV[, "traitlateralisation.Right:traitlateralisation.Right.species"])
posterior_summary(corr_phylo)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.3255912 0.4080378 -0.9464509 0.5212514
posterior_summary(corr_species)
#> Estimate Est.Error Q2.5 Q97.5
#> var1 -0.1703249 0.4116015 -0.9033031 0.5982851
summary(mod4_brms)
#> Family: categorical
#> Links: muLeft = logit; muRight = logit
#> Formula: lateralisation ~ 1 + (1 | a | gr(phylo, cov = A)) + (1 | b | species)
#> Data: sim_data4 (Number of observations: 500)
#> Draws: 4 chains, each with iter = 12000; warmup = 8000; thin = 1;
#> total post-warmup draws = 16000
#>
#> Multilevel Hyperparameters:
#> ~phylo (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muLeft_Intercept) 1.83 0.54 0.91 3.05 1.00 5668 8744
#> sd(muRight_Intercept) 1.68 0.59 0.66 2.93 1.00 2778 5490
#> cor(muLeft_Intercept,muRight_Intercept) -0.22 0.39 -0.91 0.53 1.00 2895 5511
#>
#> ~species (Number of levels: 100)
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(muLeft_Intercept) 1.25 0.44 0.32 2.12 1.00 3071 2739
#> sd(muRight_Intercept) 1.31 0.41 0.44 2.11 1.00 2261 2846
#> cor(muLeft_Intercept,muRight_Intercept) -0.17 0.39 -0.91 0.55 1.00 1824 3271
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> muLeft_Intercept 0.37 0.75 -1.13 1.85 1.00 13887 12464
#> muRight_Intercept 0.43 0.73 -1.08 1.82 1.00 14790 11493
#>
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).The c2-corrected MCMCglmm intercepts (Left 0.40, 95% CI −1.02, 1.94; Right 0.48, −0.99, 1.79) and the brms intercepts (0.37 and 0.43) are consistent with the true values (0.4 and 0.8). The variances are estimated with much less precision: the phylogenetic variance is 2.99 (0.65, 7.60) for Left and 2.59 (0.26, 7.44) for Right (true values 1 and 2.25), and the species variance is 1.53 (0.10, 4.07) and 1.78 (0.21, 4.17) (true values 1.21 and 1). The 95% CIs contain the true values, but the point estimates can be far from them.
Please look at the correlations. In this simulation, the random-effect correlations were estimated much less precisely than the variances, and the variances less precisely than the fixed effects. The 95% credible intervals of the correlations are very wide (phylogenetic: −0.33, 95% CI −0.95, 0.52; species: −0.17, −0.90, 0.60 in MCMCglmm), so close recovery of the true correlation (0) is not expected. This ordering is typical for this kind of data, but it is a property of this particular simulation (sample size and parameter values), not a general rule.
The category-specific phylogenetic variance proportions (on the latent scale of the reference-category multinomial logit, reference: Both) are…
# sigma2_phylo / (sigma2_phylo + sigma2_species + pi^2/3), calculated for each posterior draw
## MCMCglmm: c2-corrected variances
VCV <- pool_chains(mod4_mcmcglmm, "VCV") / (1 + c2a)
h2_left_mcmcglmm <- VCV[, "traitlateralisation.Left:traitlateralisation.Left.phylo"] /
(VCV[, "traitlateralisation.Left:traitlateralisation.Left.phylo"] +
VCV[, "traitlateralisation.Left:traitlateralisation.Left.species"] + pi^2 / 3)
h2_right_mcmcglmm <- VCV[, "traitlateralisation.Right:traitlateralisation.Right.phylo"] /
(VCV[, "traitlateralisation.Right:traitlateralisation.Right.phylo"] +
VCV[, "traitlateralisation.Right:traitlateralisation.Right.species"] + pi^2 / 3)
posterior_summary(h2_left_mcmcglmm) # Left vs Both
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.3606652 0.1427104 0.1063523 0.6513249
posterior_summary(h2_right_mcmcglmm) # Right vs Both
#> Estimate Est.Error Q2.5 Q97.5
#> var1 0.3137536 0.1584276 0.04067859 0.6472536
## brms
draws <- as_draws_df(mod4_brms)
h2_left_brms <- with(draws, sd_phylo__muLeft_Intercept^2 /
(sd_phylo__muLeft_Intercept^2 + sd_species__muLeft_Intercept^2 + pi^2 / 3))
h2_right_brms <- with(draws, sd_phylo__muRight_Intercept^2 /
(sd_phylo__muRight_Intercept^2 + sd_species__muRight_Intercept^2 + pi^2 / 3))
posterior_summary(h2_left_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.3945657 0.1442269 0.1265631 0.6819877
posterior_summary(h2_right_brms)
#> Estimate Est.Error Q2.5 Q97.5
#> [1,] 0.3515401 0.1619901 0.06580121 0.6717658
# values implied by the simulation settings (variances 1 and 1.5^2 for phylogeny, 1.1^2 and 1 for species)
c(left = 1 / (1 + 1.1^2 + pi^2 / 3), right = 1.5^2 / (1.5^2 + 1 + pi^2 / 3))
#> left right
#> 0.1818225 0.3440436 The estimates are 0.36 (95% CI 0.11, 0.65) for Left vs Both and 0.31 (0.04, 0.65) for Right vs Both in MCMCglmm, and 0.39 (0.13, 0.68) and 0.35 (0.07, 0.67) in brms. The values implied by the simulation settings are 0.18 (Left vs Both) and 0.34 (Right vs Both). The Right vs Both proportion is recovered well. The Left vs Both proportion is overestimated, although its 95% CIs include the true value; with 100 species, such differences between the estimates and the true values are expected for variance components of nominal models.
References and useful links
Bürkner PC. brms: An R package for Bayesian multilevel models using Stan. J. Stat. Softw. 2017. 80:1-28. doi.org/10.18637/jss.v080.i01
Gelman A, Jakulin A, Pittau MG, Su YS. A weakly informative default prior distribution for logistic and other regression models. Ann. Appl. Stat. 2008. 2:1360-1383. doi.org/10.1214/08-AOAS191
Hadfield JD. MCMC methods for multi-response generalized linear mixed models: the MCMCglmm R package. J. Stat. Softw. 2010. 33:1-22. doi.org/10.18637/jss.v033.i02. See also the MCMCglmm course notes: vignette("CourseNotes", package = "MCMCglmm").
Nakagawa S, Schielzeth H. Repeatability for Gaussian and non-Gaussian data: a practical guide for biologists. Biol. Rev. 2010. 85:935-956. doi.org/10.1111/j.1469-185X.2010.00141.x
Sheard C, Skinner N, and Caro T. The evolution of rodent tail morphology. Am. Nat. 2024. 203:629-43. doi.org/10.1086/729751
Macdonald RX, Sheard C, Howell N, and Caro T. Primate coloration and colour vision: a comparative approach. Biol. J. Linn. Soc. Lond 2024. 141:435-455. doi.org/10.1093/biolinnean/blad089
Tobias et al. AVONET: morphological, ecological and geographical data for all birds. Ecol. Lett 2022. 25:581-597. doi.org/10.1111/ele.13898
Vehtari A, Gelman A, Simpson D, Carpenter B, Bürkner PC. Rank-normalization, folding, and localization: An improved \(\hat{R}\) for assessing convergence of MCMC (with discussion). Bayesian Anal. 2021. 16:667-718. doi.org/10.1214/20-BA1221