Example 3: Multivariate generalized linear mixed models for continuous bounded outcomes
library(knitr)
library(TMB)
library(betareg)
library(ggplot2)
library(tidyverse)
library(cowplot)
library(ggcorrplot)
The motivating example analyzed in this article uses data of the body fat percentage of subjects assisted at the Endocrinology and Metabology Service of the Clinic’s Hospital of the Paraná Federal University, Curitiba, Brazil. The data set contains 298 observations and was previously analyzed by Petterle et al. (2020) by using the multivariate quasi-beta regression model. The data set is composed by two continuous and two categorical covariates, which correspond to: - subject age (in years, ranging from 18 to 87 years), - body mass index (in kg/m\(^2\), ranging from 18.5 to 29.9 kg/m\(^2\)), - gender of subjects (F: female; M: Male) and - level of physical activity practiced routinely (S: sedentary; IA: insufficiently active; A: active). The response variables refer to the body fat percentage (BFP) measured at five regions of the body.
data3 <- read.table("Data_Set.csv", header = TRUE, sep = ",", na.strings = "")
tail(data3, n = 10)
## AGE BMI SEX IPAQ ARMS LEGS TRUNK ANDROID GYNOID
## 289 79 29.4 Male Sedentary 0.367 0.444 0.452 0.473 0.479
## 290 80 28.3 Male Active 0.279 0.353 0.392 0.432 0.407
## 291 80 25.6 Male Insufficiently active 0.229 0.308 0.378 0.437 0.353
## 292 82 28.8 Female Sedentary 0.471 0.470 0.516 0.548 0.538
## 293 82 22.6 Female Sedentary 0.361 0.473 0.390 0.408 0.491
## 294 84 29.3 Male Insufficiently active 0.227 0.248 0.405 0.464 0.334
## 295 86 27.2 Male Sedentary 0.295 0.302 0.416 0.481 0.383
## 296 86 22.6 Male Sedentary 0.276 0.263 0.370 0.436 0.290
## 297 86 25.6 Male Sedentary 0.236 0.300 0.392 0.475 0.338
## 298 87 23.4 Male Sedentary 0.267 0.310 0.373 0.410 0.394
# Preparing
par(mfrow = c(4,5), mar=c(2.8, 2.6, 1.2, 0.5), mgp = c(1.6, 0.6, 0))
# cex (theme_cowplot)
fig_cex = 12
# Age
p1 <- data3 %>%
ggplot(aes(x = AGE, y = ARMS)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab("Age (years)") +
ylab("Arms") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p2 <- data3 %>%
ggplot(aes(x = AGE, y = LEGS)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab("Age (years)") +
ylab("Legs") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p3 <- data3 %>%
ggplot(aes(x = AGE, y = TRUNK)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab("Age (years)") +
ylab("Trunk") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p4 <- data3 %>%
ggplot(aes(x = AGE, y = ANDROID)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab("Age (years)") +
ylab("Android") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p5 <- data3 %>%
ggplot(aes(x = AGE, y = GYNOID)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab("Age (years)") +
ylab("Gynoid") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
# BMI
p6 <- data3 %>%
ggplot(aes(x = BMI, y = ARMS)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab(expression(paste("BMI (kg/m"^2,")"))) +
ylab("Arms") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p7 <- data3 %>%
ggplot(aes(x = BMI, y = LEGS)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab(expression(paste("BMI (kg/m"^2,")"))) +
ylab("Legs") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p8 <- data3 %>%
ggplot(aes(x = BMI, y = TRUNK)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab(expression(paste("BMI (kg/m"^2,")"))) +
ylab("Trunk") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p9 <- data3 %>%
ggplot(aes(x = BMI, y = ANDROID)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab(expression(paste("BMI (kg/m"^2,")"))) +
ylab("Android") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
p10 <- data3 %>%
ggplot(aes(x = BMI, y = GYNOID)) +
geom_point(size = 1.1, alpha = 0.8, color = "gray80") +
xlab(expression(paste("BMI (kg/m"^2,")"))) +
ylab("Gynoid") +
geom_smooth(method = lm, color = "gray70",
formula = y ~ splines::bs(x, 3),
se = T) +
theme_cowplot(fig_cex)
# Gender
p11 <- data3 %>%
ggplot(aes(x = SEX, y = ARMS)) +
geom_boxplot(fill = "gray80") +
xlab("Gender") +
ylab("Arms") +
theme_cowplot(fig_cex)
p12 <- data3 %>%
ggplot(aes(x = SEX, y = LEGS)) +
geom_boxplot(fill = "gray80") +
xlab("Gender") +
ylab("Legs") +
theme_cowplot(fig_cex)
p13 <- data3 %>%
ggplot(aes(x = SEX, y = TRUNK)) +
geom_boxplot(fill = "gray80") +
xlab("Gender") +
ylab("Trunk") +
theme_cowplot(fig_cex)
p14 <- data3 %>%
ggplot(aes(x = SEX, y = ANDROID)) +
geom_boxplot(fill = "gray80") +
xlab("Gender") +
ylab("Android") +
theme_cowplot(fig_cex)
p15 <- data3 %>%
ggplot(aes(x = SEX, y = GYNOID)) +
geom_boxplot(fill = "gray80") +
xlab("Gender") +
ylab("Gynoid") +
theme_cowplot(fig_cex)
# IPAQ
data3$IPAQ <- factor(data3$IPAQ)
levels(data3$IPAQ) <- c("S", "IA", "A")
p16 <- data3 %>%
ggplot(aes(x = IPAQ, y = ARMS)) +
geom_boxplot(fill = "gray80") +
xlab("IPAQ") +
ylab("Arms") +
theme_cowplot(fig_cex)
p17 <- data3 %>%
ggplot(aes(x = IPAQ, y = LEGS)) +
geom_boxplot(fill = "gray80") +
xlab("IPAQ") +
ylab("Legs") +
theme_cowplot(fig_cex)
p18 <- data3 %>%
ggplot(aes(x = IPAQ, y = TRUNK)) +
geom_boxplot(fill = "gray80") +
xlab("IPAQ") +
ylab("Trunk") +
theme_cowplot(fig_cex)
p19 <- data3 %>%
ggplot(aes(x = IPAQ, y = ANDROID)) +
geom_boxplot(fill = "gray80") +
xlab("IPAQ") +
ylab("Android") +
theme_cowplot(fig_cex)
p20 <- data3 %>%
ggplot(aes(x = IPAQ, y = GYNOID)) +
geom_boxplot(fill = "gray80") +
xlab("IPAQ") +
ylab("Gynoid") +
theme_cowplot(fig_cex)
# Figure
plot_grid(p1, p2, p3, p4, p5,
p6, p7, p8, p9, p10,
p11, p12, p13, p14, p15,
p16, p17, p18, p19, p20,
label_size = 13,
labels = c("(A)", "(B)", "(C)", "(D)", "(E)",
"(F)", "(G)", "(H)", "(I)", "(J)",
"(K)", "(L)", "(M)", "(N)", "(O)",
"(P)", "(Q)", "(R)", "(S)", "(T)"),
hjust = -0.05, vjust = 1,
ncol = 5, nrow = 4)
Let \(Y_1, \ldots, Y_n\) be independent random variables with probability density function given by \[ f(y;\mu,\phi) = \dfrac{\Gamma(\phi)}{\Gamma(\mu \phi) \Gamma[(1 - \mu)\phi]} y^{\mu \phi - 1} (1 - y)^{(1 - \mu) \phi - 1}, \] where \(y, \mu \in (0,1)\) and \(\phi > 0\) denote the precision parameter. According to Ferrari and Cribari-Neto (2004) the expectation and variance of the beta distribution are given, respectively, by
\[\begin{equation} \label{betamoments} \mathrm{E}(Y) = \mu \quad~\mathrm{and}~\quad \mathrm{Var}(Y) = \dfrac{\mu(1-\mu)}{1 + \phi}. \end{equation}\]
Let \(\mathbf{Y}\) be a response variable matrix \(N \times R\), where rows \(i = 1, \ldots, N\) are independent subjects and columns \(r = 1, \ldots, R\) refers to the \(R\) response variables. Let \(y_{ir} \in (0,1)\) be the observed value of a random variable \(Y_{ir}\), and let \(\mathbf{u}_i = (u_{i1}, \ldots, u_{iR})\) be the vector of random intercepts for the subject \(i\). For specification of the MGLMM, consider the following hierarchical structure \[\begin{align} \nonumber \label{eq:dist} Y_{ir} | u_{ir} & \sim \mathcal{B}(\mu_{ir}, \phi_{r}), \nonumber \\ g_r(\mu_{ir}) & = \mathbf{x}_{ir}^{\top}\boldsymbol{\beta}_r + u_{ir}, \end{align}\] where \(\phi_{r}\) is assumed to be constant for the \(r^{th}\) response variable. The function \(g(\cdot)\) is a suitable link function for binary data. In this notation, \(\mathbf{x}_{ir}\) and \(\boldsymbol{\beta}_r\) are \(Q_r \times 1\) vectors of known covariates and unknown regression coefficients associated to the expectation of the \(r^{th}\) response variable for the \(i^{th}\) subject. Note that, the index \(r\) was introduced to ensure different set of covariates for each response variable. Moreover, we assume that the random intercepts follow a multivariate Gaussian distribution, \(u_{ir} \sim \mathcal{MVN}_r(\mathbf{0}, \boldsymbol{\Sigma})\), where \(\boldsymbol{\Sigma}\) is the \(R \times R\) unstructured covariance matrix. Thus, the random intercepts distribution is given by \[\begin{equation} \label{eq:gaussmult} \begin{pmatrix} u_{i1} \\ \vdots \\ u_{iR} \\ \end{pmatrix} \sim \mathcal{MVN}_R \left[ \begin{pmatrix} 0 \\ \vdots \\ 0 \\ \end{pmatrix}, \mathop{\boldsymbol{\Sigma}}_{R \times R} = \begin{pmatrix} \sigma_1^2 \hspace{-0.2cm} & \hspace{-0.2cm} \ldots \hspace{-0.2cm} & \hspace{-0.2cm}~\rho_{1R} \sigma_1 \sigma_R \\ \vdots \hspace{-0.1cm} & \hspace{-0.2cm} \ddots \hspace{-0.2cm} & \hspace{-0.2cm} \vdots \\ \rho_{1R} \sigma_1 \sigma_R \hspace{-0.1cm} & \hspace{-0.1cm} \ldots \hspace{-0.2cm} & \hspace{-0.2cm} \sigma_R^2 \\ \end{pmatrix} \right], \end{equation}\] where \(\rho_{RR'} \in [-1, 1]\) and \(\sigma_R^2 > 0\), for \(r, r' = 1,, \ldots, R\), are the correlation and variance of the random intercepts, respectively. We highlight that, in our implementation the covariance matrix of the multivariate Gaussian distribution is specified as follows \[\begin{equation} \label{eq:covTMB} \boldsymbol{\Sigma} = \mathrm{diag}(\sigma_1, \ldots, \sigma_R) \boldsymbol{\Sigma}_{\rho} \mathrm{diag}(\sigma_1, \ldots, \sigma_R), \end{equation}\] where \(\mathrm{diag}(\sigma_1, \ldots, \sigma_R)\) for \(r = 1, \ldots, R\) is the diagonal matrix of the standard deviations of the random intercepts and \(\boldsymbol{\Sigma}_{\rho}\) is the \(R \times R\) unstructured correlation matrix given by \[\begin{equation} \label{eq:corrTMB} \boldsymbol{\Sigma}_{\rho} = \mathbf{D}^{-\tfrac{1}{2}} \mathbf{L} \mathbf{L}^{\top} \mathbf{D}^{-\tfrac{1}{2}}, \end{equation}\] where \(\mathbf{L}\) is a lower-triangular matrix, composed by 1’s on the diagonal and correlation parameters \(\theta_1, \ldots, \theta_{R(R-1)/2}\) in the lower triangle. For \(R = 5\), the lower-triangular matrix is given by \[\begin{equation} \nonumber \mathbf{L} = \begin{bmatrix} 1 & & & & \\ \theta_1 & 1 & & & \\ \theta_2 & \theta_5 & 1 & & \\ \theta_3 & \theta_6 & \theta_8 & 1 & \\ \theta_4 & \theta_7 & \theta_9 & \theta_{10} & 1 \\ \end{bmatrix}. \end{equation}\] Note that, in the correlation matrix \(\mathbf{D} = \mathrm{diag}(\mathbf{L} \mathbf{L}^{\top})\) and \(\mathbf{D}^{-\tfrac{1}{2}}\) is the corresponding inverse square root matrix. This parameterization allows us to estimate the \(R(R-1)/2\) correlation parameters respecting the constraint of positive definite matrix. Furthermore, such parameterization facilitates the estimation of the correlation parameters, since \(\theta_r \in \mathrm{R}\) for \(r = 1, \ldots, R(R-1)/2\).
Let \(\boldsymbol{\theta} = (\boldsymbol{\beta}^{\top}, \boldsymbol{\phi}^{\top}, \boldsymbol{\tau}^{\top})^{\top}\) be a vector composed of three sets of parameters, where \(\boldsymbol{\beta} = (\boldsymbol{\beta}_1^{\top}, \ldots, \boldsymbol{\beta}_R^{\top})^{\top}\), \(\boldsymbol{\phi} = (\phi_1, \ldots, \phi_R)^{\top}\) and \(\boldsymbol{\tau} = (\sigma_1, \ldots, \sigma_R, \rho_{1R'}, \ldots, \rho_{RR'})^{\top}\) are vectors \(Q \times 1\), \(R \times 1\) and \(J \times 1\) of parameters associated with the regression, precision and covariance structures, respectively. In this notation, \(Q = \sum_r Q_r\) correspond to all regression parameters and \(\boldsymbol{\tau}\) has dimension \(J = R + R(R-1)/2\), where \(R\) and \(R(R - 1)/2\) are the number of standard deviations and correlation parameters of the covariance matrix, respectively.
Let \(\mathbf{y}_i = (y_{i1}, \ldots, y_{iR})\) denote the \(i^{th}\) row of the response variable matrix and let \(\mathbf{u}_i = (u_{i1}, \ldots, u_{iR})\) denote the corresponding vector of correlated random intercepts, for \(i = 1, \ldots, N\) and \(r = 1, \ldots, R\). For each independent subject, the marginal likelihood is given by \[\begin{equation} \label{eq:log-Lik} \mathcal{L}(\boldsymbol{\theta} | \mathbf{y}_i) = \int_{\mathrm{R}^r} \bigg\{ \prod_{r = 1}^{R} f_{r}(y_{ir} | \mathbf{u}_i, \boldsymbol{\beta}_r, \phi_r) \bigg\} f(\mathbf{u}_i | \boldsymbol{\Sigma}) d\mathbf{u}_i, \end{equation}\] where \(f_{r}(y_{ir} | \mathbf{u}_{i}, \boldsymbol{\beta}_r, \phi_r)\) denote the \(r^{th}\) conditional distribution following the hierarchical specification and \(f(\mathbf{u}_{i} | \boldsymbol{\Sigma})\) denote the multivariate Gaussian distribution of the random intercepts.
We assume independence between the \(N\) subjects. Thus, the full marginal likelihood function for the beta probability density function is given by \[\begin{align} \label{eq:log-LikBeta} \mathcal{L}(\boldsymbol{\theta} | \mathbf{y}) = \prod_{i = 1}^{N} \int_{\mathrm{R}^r} & \bigg\{ \prod_{r = 1}^{R} \dfrac{ \Gamma(\phi_r) }{\Gamma(\mu_{ir}\phi_r) \Gamma((1-\mu_{ir})\phi_r) } y_{ir}^{\mu_{ir} \phi_r-1} (1 - y_{ir})^{\phi_r (1 - \mu_{ir}) - 1 } \bigg\} \nonumber \\ & \times (2\pi)^{-R/2} |\boldsymbol{\Sigma}|^{-1/2} \exp \bigg( -\dfrac{1}{2} \mathbf{u}_i^{\top}\boldsymbol{\Sigma}^{-1} \mathbf{u}_i \bigg) d\mathbf{u}_i \end{align}\]
For details, see Petterle et al. (2021)
For details about TMB package see Kristensen et al. (2016).
C++ template// MGLMM Beta
#include <TMB.hpp>
template<class Type>
Type objective_function<Type>::operator() ()
{
using namespace density;
DATA_VECTOR(Y1);
DATA_VECTOR(Y2);
DATA_VECTOR(Y3);
DATA_VECTOR(Y4);
DATA_VECTOR(Y5);
DATA_MATRIX(X);
PARAMETER_VECTOR(beta1);
PARAMETER_VECTOR(beta2);
PARAMETER_VECTOR(beta3);
PARAMETER_VECTOR(beta4);
PARAMETER_VECTOR(beta5);
PARAMETER_MATRIX(U);
PARAMETER_VECTOR(rho);
PARAMETER_VECTOR(sigma);
PARAMETER_VECTOR(phi);
// Preparing
vector<Type> rho_temp(10);
rho_temp = rho;
vector<Type> sigma_temp(5);
sigma_temp = sigma;
vector<Type> mu1(Y1.size());
vector<Type> mu2(Y2.size());
vector<Type> mu3(Y3.size());
vector<Type> mu4(Y4.size());
vector<Type> mu5(Y5.size());
vector<Type> phi_temp(5);
phi_temp = phi;
vector<Type> shapeA1(Y1.size());
vector<Type> shapeA2(Y2.size());
vector<Type> shapeA3(Y3.size());
vector<Type> shapeA4(Y4.size());
vector<Type> shapeA5(Y5.size());
vector<Type> shapeB1(Y1.size());
vector<Type> shapeB2(Y2.size());
vector<Type> shapeB3(Y3.size());
vector<Type> shapeB4(Y4.size());
vector<Type> shapeB5(Y5.size());
// Linear predictor for mean
mu1 = exp(X*beta1 + U.col(0).array())/(1 + exp(X*beta1 + U.col(0).array()));
mu2 = exp(X*beta2 + U.col(1).array())/(1 + exp(X*beta2 + U.col(1).array()));
mu3 = exp(X*beta3 + U.col(2).array())/(1 + exp(X*beta3 + U.col(2).array()));
mu4 = exp(X*beta4 + U.col(3).array())/(1 + exp(X*beta4 + U.col(3).array()));
mu5 = exp(X*beta5 + U.col(4).array())/(1 + exp(X*beta5 + U.col(4).array()));
// Shape A (Beta)
shapeA1 = mu1*exp(phi(0));
shapeA2 = mu2*exp(phi(1));
shapeA3 = mu3*exp(phi(2));
shapeA4 = mu4*exp(phi(3));
shapeA5 = mu5*exp(phi(4));
// Shape B (Beta)
shapeB1 = (1-mu1)*exp(phi(0));
shapeB2 = (1-mu2)*exp(phi(1));
shapeB3 = (1-mu3)*exp(phi(2));
shapeB4 = (1-mu4)*exp(phi(3));
shapeB5 = (1-mu5)*exp(phi(4));
// Full Log-likelihood
Type nll1 = 0;
for(int i=0; i<Y1.size(); i++)
nll1 -= dbeta(Y1(i), shapeA1(i), shapeB1(i), true);
Type nll2 = 0;
for(int i=0; i<Y2.size(); i++)
nll2 -= dbeta(Y2(i), shapeA2(i), shapeB2(i), true);
Type nll3 = 0;
for(int i=0; i<Y3.size(); i++)
nll3 -= dbeta(Y3(i), shapeA3(i), shapeB3(i), true);
Type nll4 = 0;
for(int i=0; i<Y4.size(); i++)
nll4 -= dbeta(Y4(i), shapeA4(i), shapeB4(i), true);
Type nll5 = 0;
for(int i=0; i<Y5.size(); i++)
nll5 -= dbeta(Y5(i), shapeA5(i), shapeB5(i), true);
Type nll = 0;
for(int i = 0; i < Y1.size(); i++)
nll += VECSCALE(UNSTRUCTURED_CORR(rho), sigma)(U.row(i));
matrix<Type> Cor(5,5);
Cor = UNSTRUCTURED_CORR(rho).cov();
REPORT(Cor);
return nll1 + nll2 + nll3 + nll4 + nll5 + nll;
}
## Response 1
fit1 <- betareg::betareg(ARMS ~ AGE + BMI + SEX + IPAQ,
data = data3)
## Response 2
fit2 <- betareg::betareg(LEGS ~ AGE + BMI + SEX + IPAQ,
data = data3)
## Response 3
fit3 <- betareg::betareg(TRUNK ~ AGE + BMI + SEX + IPAQ,
data = data3)
## Response 4
fit4 <- betareg::betareg(ANDROID ~ AGE + BMI + SEX + IPAQ,
data = data3)
## Response 5
fit5 <- betareg::betareg(GYNOID ~ AGE + BMI + SEX + IPAQ,
data = data3)
compile("MGLMM_Beta.cpp")
dyn.load(dynlib("MGLMM_Beta"))
X <- model.matrix(~ AGE + BMI + SEX + IPAQ, data3)
data <- list(Y1 = data3$ARMS, Y2 = data3$LEGS, Y3 = data3$TRUNK,
Y4 = data3$ANDROID, Y5 = data3$GYNOID, X = X)
beta1 = as.numeric(coef(fit1)[-7])
beta2 = as.numeric(coef(fit2)[-7])
beta3 = as.numeric(coef(fit3)[-7])
beta4 = as.numeric(coef(fit4)[-7])
beta5 = as.numeric(coef(fit5)[-7])
# Precision
phi1 <- log(as.numeric(coef(fit1)[7]))
phi2 <- log(as.numeric(coef(fit2)[7]))
phi3 <- log(as.numeric(coef(fit3)[7]))
phi4 <- log(as.numeric(coef(fit4)[7]))
phi5 <- log(as.numeric(coef(fit5)[7]))
parameters <- list(beta1 = beta1, beta2 = beta2, beta3 = beta3,
beta4 = beta4, beta5 = beta5,
phi = c(phi1, phi2, phi3, phi4, phi5),
U = matrix(0, ncol = 5, nrow = 298),
rho = rep(0,10), sigma = rep(0.11, 5))
MGLMM_Beta <- MakeADFun(data, parameters, DLL = "MGLMM_Beta",
random = "U",
hessian = TRUE, silent = T)
nlminb()fit_mglmm <- nlminb(start = MGLMM_Beta$par, objective = MGLMM_Beta$fn,
gradient = MGLMM_Beta$gr,
control = list(eval.max = 1000, iter.max = 1000,
abs.tol = 1e-04, rel.tol = 1e-04))
## Warning in nlminb(start = MGLMM_Beta$par, objective = MGLMM_Beta$fn, gradient =
## MGLMM_Beta$gr, : NA/NaN function evaluation
fit_mglmm
## $par
## beta1 beta1 beta1 beta1 beta1
## -2.9537491927 0.0046383771 0.0918552429 -0.9389207160 -0.1166535159
## beta1 beta2 beta2 beta2 beta2
## -0.2619628418 -1.9672071507 0.0001473365 0.0692177283 -0.8835971770
## beta2 beta2 beta3 beta3 beta3
## -0.0467723463 -0.1577925196 -3.1611875259 0.0040957943 0.1047017779
## beta3 beta3 beta3 beta4 beta4
## -0.4356444155 -0.1016530631 -0.1865957786 -3.0316100097 0.0049453633
## beta4 beta4 beta4 beta4 beta5
## 0.1047544125 -0.3767117598 -0.1117457458 -0.1891741565 -1.5116539010
## beta5 beta5 beta5 beta5 beta5
## -0.0009244796 0.0623411756 -0.7485710014 -0.0656823897 -0.1526492326
## rho rho rho rho rho
## 1.2885883549 1.2852405657 0.1192039273 9.5178060962 -0.4353073592
## rho rho rho rho rho
## 7.7765089152 6.3719306256 4.3162482303 1.3488597561 0.0594100007
## sigma sigma sigma sigma sigma
## 0.3074049218 0.2888021111 0.2744367528 0.3022942515 0.2424567260
## phi phi phi phi phi
## 8.6044702209 8.1910687573 10.8583572000 6.3380327317 7.4774895770
##
## $objective
## [1] -3155.856
##
## $convergence
## [1] 0
##
## $iterations
## [1] 317
##
## $evaluations
## function gradient
## 470 318
##
## $message
## [1] "relative convergence (4)"
report <- sdreport(MGLMM_Beta)
summary(report, "fixed", p.value = TRUE)
## Estimate Std. Error z value Pr(>|z^2|)
## beta1 -2.9537491927 0.1514013061 -19.5094036 9.134143e-85
## beta1 0.0046383771 0.0011655556 3.9795417 6.904825e-05
## beta1 0.0918552429 0.0067704794 13.5670219 6.282308e-42
## beta1 -0.9389207160 0.0373109021 -25.1647820 9.737430e-140
## beta1 -0.1166535159 0.0545352174 -2.1390492 3.243168e-02
## beta1 -0.2619628418 0.0523640232 -5.0027256 5.652536e-07
## beta2 -1.9672071507 0.1426065524 -13.7946477 2.744905e-43
## beta2 0.0001473365 0.0010973312 0.1342680 8.931906e-01
## beta2 0.0692177283 0.0063713807 10.8638507 1.713673e-27
## beta2 -0.8835971770 0.0351284309 -25.1533346 1.299332e-139
## beta2 -0.0467723463 0.0513979967 -0.9100033 3.628208e-01
## beta2 -0.1577925196 0.0493346757 -3.1984100 1.381877e-03
## beta3 -3.1611875259 0.1344413063 -23.5135139 2.966984e-122
## beta3 0.0040957943 0.0010348929 3.9576987 7.567534e-05
## beta3 0.1047017779 0.0060076606 17.4280448 5.054482e-68
## beta3 -0.4356444155 0.0331198398 -13.1535786 1.623071e-39
## beta3 -0.1016530631 0.0484720614 -2.0971475 3.598052e-02
## beta3 -0.1865957786 0.0465310580 -4.0101340 6.068429e-05
## beta4 -3.0316100097 0.1545654598 -19.6137611 1.179764e-85
## beta4 0.0049453633 0.0011864367 4.1682487 3.069489e-05
## beta4 0.1047544125 0.0069007307 15.1801913 4.783848e-52
## beta4 -0.3767117598 0.0380200344 -9.9082435 3.833258e-23
## beta4 -0.1117457458 0.0555184668 -2.0127671 4.413913e-02
## beta4 -0.1891741565 0.0533191199 -3.5479610 3.882257e-04
## beta5 -1.5116539010 0.1214004619 -12.4517970 1.367316e-35
## beta5 -0.0009244796 0.0009328939 -0.9909804 3.216951e-01
## beta5 0.0623411756 0.0054209359 11.5000761 1.317991e-30
## beta5 -0.7485710014 0.0298810308 -25.0517128 1.672408e-138
## beta5 -0.0656823897 0.0436734978 -1.5039416 1.325964e-01
## beta5 -0.1526492326 0.0419176217 -3.6416482 2.708981e-04
## rho 1.2885883549 0.1287308027 10.0099458 1.378281e-23
## rho 1.2852405657 0.1124908383 11.4252910 3.126066e-30
## rho 0.1192039273 0.0877568424 1.3583434 1.743547e-01
## rho 9.5178060962 5.5194688501 1.7244062 8.463455e-02
## rho -0.4353073592 0.8111829307 -0.5366328 5.915213e-01
## rho 7.7765089152 4.4158232060 1.7610553 7.822904e-02
## rho 6.3719306256 3.5652211129 1.7872470 7.389758e-02
## rho 4.3162482303 2.4667196220 1.7497928 8.015407e-02
## rho 1.3488597561 0.7587222054 1.7778045 7.543597e-02
## rho 0.0594100007 0.5757128768 0.1031938 9.178092e-01
## sigma 0.3074049218 0.0141011794 21.7999440 2.323008e-105
## sigma 0.2888021111 0.0128919670 22.4017105 3.787544e-111
## sigma 0.2744367528 0.0113103508 24.2642123 4.681304e-130
## sigma 0.3022942515 0.0137363555 22.0068745 2.474754e-107
## sigma 0.2424567260 0.0110253496 21.9908424 3.523851e-107
## phi 8.6044702209 3.3615126898 2.5597018 1.047620e-02
## phi 8.1910687573 1.7501704994 4.6801547 2.866585e-06
## phi 10.8583572000 3.9578992824 2.7434648 6.079457e-03
## phi 6.3380327317 0.1321140068 47.9739649 0.000000e+00
## phi 7.4774895770 0.6311663196 11.8470985 2.227711e-32
Beta_report <- MGLMM_Beta$report()
COR_Beta <- Beta_report$Cor
colnames(COR_Beta) <- rownames(COR_Beta) <- c("Arms", "Legs", "Trunk",
"Android", "Gynoid")
COR_Beta
## Arms Legs Trunk Android Gynoid
## Arms 1.0000000 0.7900159 0.7871365 0.7713563 0.8088809
## Legs 0.7900159 1.0000000 0.6666091 0.5877548 0.9749532
## Trunk 0.7871365 0.6666091 1.0000000 0.9905704 0.7815699
## Android 0.7713563 0.5877548 0.9905704 1.0000000 0.7131318
## Gynoid 0.8088809 0.9749532 0.7815699 0.7131318 1.0000000
ggcorrplot::ggcorrplot(COR_Beta, hc.order = F, type = "lower",
lab = TRUE, show.legend = F, lab_size = 6, tl.cex = 16,
ggtheme = ggplot2::theme_light(),
colors = c("gray60", "gray60", "gray60"))
Ferrari, Silvia, and Francisco Cribari-Neto. 2004. “Beta Regression for Modelling Rates and Proportions.” Journal of Applied Statistics 31 (7): 799–815.
Kristensen, Kasper, Anders Nielsen, Casper W Berg, Hans Skaug, and Bradley M Bell. 2016. “TMB: Automatic Differentiation and Laplace Approximation.” Journal of Statistical Software 70 (5).
Petterle, Ricardo Rasmussen, Henrique Aparecido Laureano, Guilherme Parreira da Silva, and Wagner Hugo Bonat. 2021. “Multivariate Generalized Linear Mixed Models for Continuous Bounded Outcomes: Analyzing the Body Fat Percentage Data.” Statistical Methods in Medical Research (Accepted): 1–26.
Petterle, Ricardo R, Wagner H Bonat, Cassius T Scarpin, Thaı́sa Jonasson, and Victória ZC Borba. 2020. “Multivariate Quasi-Beta Regression Models for Continuous Bounded Data.” The International Journal of Biostatistics 1 (ahead-of-print).