# Diet Analysis of Horses Using Dirichlet and Beta Regression Models
# Load libraries
library(readxl)
library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.3.3
## Warning: package 'tidyr' was built under R version 4.3.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(patchwork)
library(DirichletReg)
## Loading required package: Formula
library(zCompositions)
## Loading required package: MASS
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:patchwork':
##
## area
##
## The following object is masked from 'package:dplyr':
##
## select
##
## Loading required package: NADA
## Loading required package: survival
##
## Attaching package: 'NADA'
##
## The following object is masked from 'package:stats':
##
## cor
##
## Loading required package: truncnorm
library(betareg)
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(emmeans)
library(dplyr)
theme_set(theme_bw())
# Section 1: Przewalski's Horses
# Load and prepare data
dieta <- read_excel("Przewalski.xlsx")
dieta$Season <- factor(dieta$Season, levels = c("winter", "spring", "summer", "autumn"))
# Prepare compositional data for Dirichlet regression
items <- dieta %>% dplyr::select(Graminoids:Other_herbaceous) %>% DR_data()
## Warning in DR_data(.): not all rows sum up to 1 => normalization forced
## some entries are 0 or 1 => transformation forced
# Dirichlet Regression Models
m0 <- DirichReg(items ~ 1, data = dieta)
ms <- DirichReg(items ~ Season, data = dieta)
# Model comparison using AIC and Likelihood Ratio Test
models <- list(Null = m0, Season = ms)
AIC_models <- sapply(models, AIC) %>% as.data.frame()
colnames(AIC_models) <- "AIC"
AIC_models$K <- sapply(models, \(m) m$npar)
AIC_models$LL <- sapply(models, logLik)
AIC_models <- AIC_models[order(AIC_models$AIC), ]
AIC_models$deltaAIC <- AIC_models$AIC - AIC_models$AIC[1]
AIC_models$weight <- exp(-0.5 * AIC_models$deltaAIC) %>% {./sum(.)}
AIC_models$`p value` <- sapply(list(m0, ms), \(x) anova(m0, x)$`Pr(>Chi)`[2])
anova(m0, ms)
## Analysis of Deviance Table
##
## Model 1: DirichReg(formula = items ~ 1, data = dieta)
## Model 2: DirichReg(formula = items ~ Season, data = dieta)
##
## Deviance N. par Difference df Pr(>Chi)
## Model 1 -209.05 4
## Model 2 -266.07 16 57.019 12 7.841e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
drop1(ms)
## CAVEAT: drop1() is still an experimental feature. If you plan to use this
## function, please double-check results, e.g., by comparing two models
## using anova().
## Single term deletions
##
## Model:
## items ~ Season
## Df Deviance AIC LRT Pr(>Chi)
## <none> -266.07 -234.07
## Other_herbaceous: Season 3 -264.45 -238.45 1.6203 0.6547934
## Fabaceae: Season 3 -263.43 -237.43 2.6442 0.4497996
## Woody: Season 3 -254.94 -228.94 11.1288 0.0110493 *
## Graminoids: Season 3 -248.92 -222.92 17.1467 0.0006593 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Model diagnostics
res <- residuals(ms, type = "standardized")
boxplot(res, main = "Residuals by Component (Przewalski)")
fitted_vals <- fitted(ms)
par(mfrow = c(1, ncol(fitted_vals)))
for (i in 1:ncol(fitted_vals)) {
plot(fitted_vals[, i], res[, i], main = colnames(fitted_vals)[i],
xlab = "Fitted", ylab = "Residuals")
abline(h = 0, col = "red")
}
# Prepare beta regression data
items2 <- items |> unclass() |> as.data.frame() |> cbind(Season = dieta$Season)
# Beta regression for each food group
# graminoids
mb_Graminoids0 <- betareg(Graminoids ~ Season,
data = items2)
mb_Graminoids <- betareg(Graminoids ~ Season|Season,
data = items2)
lrtest(mb_Graminoids0, mb_Graminoids)
## Likelihood ratio test
##
## Model 1: Graminoids ~ Season
## Model 2: Graminoids ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 28.239
## 2 8 31.280 3 6.0823 0.1077
lrtest(update(mb_Graminoids0, ~1), mb_Graminoids0)
## Likelihood ratio test
##
## Model 1: Graminoids ~ 1
## Model 2: Graminoids ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 15.355
## 2 5 28.239 3 25.768 1.066e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Graminoids0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring 0.13109 0.0416 Inf 3.148 0.0089
## winter - summer 0.27689 0.0398 Inf 6.962 <.0001
## winter - autumn 0.14065 0.0480 Inf 2.931 0.0178
## spring - summer 0.14580 0.0449 Inf 3.249 0.0064
## spring - autumn 0.00955 0.0523 Inf 0.183 0.9978
## summer - autumn -0.13625 0.0508 Inf -2.682 0.0368
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### fabaceae
mb_Fabaceae0 <- betareg(Fabaceae ~ Season,
data = items2)
mb_Fabaceae <- betareg(Fabaceae ~ Season|Season,
data = items2)
lrtest(mb_Fabaceae0, mb_Fabaceae)
## Likelihood ratio test
##
## Model 1: Fabaceae ~ Season
## Model 2: Fabaceae ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 40.877
## 2 8 43.552 3 5.3519 0.1478
lrtest(update(mb_Fabaceae0, ~1), mb_Fabaceae0)
## Likelihood ratio test
##
## Model 1: Fabaceae ~ 1
## Model 2: Fabaceae ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 33.645
## 2 5 40.877 3 14.464 0.002337 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Fabaceae0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.0406 0.0234 Inf -1.735 0.3052
## winter - summer -0.1097 0.0261 Inf -4.210 0.0001
## winter - autumn -0.0756 0.0313 Inf -2.412 0.0748
## spring - summer -0.0691 0.0301 Inf -2.296 0.0989
## spring - autumn -0.0349 0.0347 Inf -1.005 0.7464
## summer - autumn 0.0341 0.0366 Inf 0.933 0.7869
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### woody
mb_Woody0 <- betareg(Woody ~ Season,
data = items2)
mb_Woody <- betareg(Woody ~ Season|Season,
data = items2)
lrtest(mb_Woody0, mb_Woody)
## Likelihood ratio test
##
## Model 1: Woody ~ Season
## Model 2: Woody ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 55.317
## 2 8 56.036 3 1.4374 0.6968
lrtest(update(mb_Woody0, ~1), mb_Woody0)
## Likelihood ratio test
##
## Model 1: Woody ~ 1
## Model 2: Woody ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 51.385
## 2 5 55.317 3 7.863 0.04893 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Woody0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring 0.03782 0.0143 Inf 2.644 0.0409
## winter - summer 0.00228 0.0156 Inf 0.146 0.9989
## winter - autumn 0.01721 0.0175 Inf 0.981 0.7602
## spring - summer -0.03554 0.0136 Inf -2.615 0.0442
## spring - autumn -0.02061 0.0158 Inf -1.304 0.5601
## summer - autumn 0.01493 0.0170 Inf 0.880 0.8153
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### other_herbaceous
mb_Other_herbaceous0 <- betareg(Other_herbaceous ~ Season,
data = items2)
mb_Other_herbaceous <- betareg(Other_herbaceous ~ Season|Season,
data = items2)
lrtest(mb_Other_herbaceous0, mb_Other_herbaceous)
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ Season
## Model 2: Other_herbaceous ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 32.622
## 2 8 38.128 3 11.011 0.01167 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
lrtest(update(mb_Other_herbaceous, ~1), mb_Other_herbaceous)
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ 1 | Season
## Model 2: Other_herbaceous ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 27.383
## 2 8 38.128 3 21.489 8.332e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Other_herbaceous, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.1103 0.0313 Inf -3.522 0.0024
## winter - summer -0.1615 0.0393 Inf -4.108 0.0002
## winter - autumn -0.0868 0.0298 Inf -2.917 0.0186
## spring - summer -0.0512 0.0493 Inf -1.038 0.7268
## spring - autumn 0.0235 0.0421 Inf 0.557 0.9447
## summer - autumn 0.0747 0.0484 Inf 1.544 0.4112
##
## P value adjustment: tukey method for comparing a family of 4 estimates
# Diet composition plot
pdieta <- dieta %>%
dplyr::select(Graminoids:Other_herbaceous) %>% # subconjunt amb dieta nom?s
transmute(total = rowSums(.)) %>% # calculem abund. total per individu
bind_cols(dieta) %>% # ajuntem el total a dd
mutate(across(Graminoids:Other_herbaceous, ~.x/total))
ladieta <- pivot_longer(pdieta, cols = Graminoids:Other_herbaceous,
names_to = "Species",
values_to = "p_i")
ladieta$Species <- factor(ladieta$Species,
levels = c("Graminoids",
"Fabaceae", "Other_herbaceous", "Woody"),
labels = c("Poaceae",
"Fabaceae", "Other herbaceous", "Woody"))
ladieta$Season <- factor(ladieta$Season,
levels = c("summer", "autumn", "winter", "spring"))
ggplot(ladieta, aes(Species, p_i)) +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.3) +
stat_summary(fun = mean, geom = "col") +
facet_wrap(~ Season, nrow = 1) +
labs(title = "Diet Composition (Przewalski)", x = NULL, y = NULL) +
theme(aspect.ratio = 1, plot.title = element_text(hjust = 0.5, size = 14),
axis.text.x = element_text(angle = 45, hjust = 1))
# Section 2: Potokka Horses
# Load and prepare data
dieta <- read_excel("Potokka.xlsx")
dieta$Season <- factor(dieta$Season, levels = c("winter", "spring", "summer", "autumn"))
# Prepare compositional data for Dirichlet regression
items <- dieta %>% dplyr::select(Ampelodesmos:Other_herbaceous) %>% DR_data()
## Warning in DR_data(.): not all rows sum up to 1 => normalization forced
# Dirichlet Regression Models
m0 <- DirichReg(items ~ 1, data = dieta)
mm <- DirichReg(items ~ Season, data = dieta)
# AIC model comparison
models <- list(Null = m0, Season = mm)
AIC_models <- sapply(models, AIC)
AIC_models <- as.data.frame(AIC_models)
names(AIC_models) <- "AIC"
rownames(AIC_models) <- names(models)
AIC_models$K <- sapply(models, \(m) m$npar)
AIC_models$LL <- sapply(models, logLik)
AIC_models <- AIC_models[order(AIC_models$AIC), ]
AIC_models$deltaAIC <- AIC_models$AIC - AIC_models$AIC[1]
.tmp <- exp(-1/2*AIC_models$deltaAIC)
AIC_models$weight <- .tmp/sum(.tmp)
AIC_models <- AIC_models[, c("K", "AIC", "deltaAIC", "weight", "LL")]
apply(AIC_models, 2, signif, 4)
## K AIC deltaAIC weight LL
## Season 20 -192.2 0.00 1.000e+00 116.10
## Null 5 -115.3 76.96 1.944e-17 62.63
AIC_models$`p value` <- sapply(list(m0, mm),
\(x) anova(m0, x)$`Pr(>Chi)`[2])
anova(m0, mm)
## Analysis of Deviance Table
##
## Model 1: DirichReg(formula = items ~ 1, data = dieta)
## Model 2: DirichReg(formula = items ~ Season, data = dieta)
##
## Deviance N. par Difference df Pr(>Chi)
## Model 1 -125.26 5
## Model 2 -232.22 20 106.96 15 6.171e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
drop1(mm)
## Single term deletions
##
## Model:
## items ~ Season
## Df Deviance AIC LRT Pr(>Chi)
## <none> -232.22 -192.22
## Other_graminoids: Season 3 -230.09 -196.09 2.1260 0.54667
## Other_herbaceous: Season 3 -229.71 -195.71 2.5149 0.47260
## Woody: Season 3 -228.30 -194.30 3.9242 0.26977
## Brachypodium: Season 3 -226.24 -192.24 5.9864 0.11228
## Ampelodesmos: Season 3 -224.00 -190.00 8.2225 0.04163 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Model diagnostics
res <- residuals(mm, type = "standardized")
boxplot(res, main = "Residuals by Component (Potokka)")
fitted_vals <- fitted(mm)
par(mfrow = c(1, ncol(fitted_vals)))
for (i in 1:ncol(fitted_vals)) {
plot(fitted_vals[, i], res[, i], main = colnames(fitted_vals)[i],
xlab = "Fitted", ylab = "Residuals")
abline(h = 0, col = "red")
}
# Prepare beta regression data
items2 <- items |> unclass() |> as.data.frame() |> cbind(Season = dieta$Season)
# Run beta models
#### ampelodesmos
mb_Ampelodesmos0 <- betareg(Ampelodesmos ~ Season,
data = items2)
mb_Ampelodesmos <- betareg(Ampelodesmos ~ Season|Season,
data = items2)
lrtest(mb_Ampelodesmos0, mb_Ampelodesmos)
## Likelihood ratio test
##
## Model 1: Ampelodesmos ~ Season
## Model 2: Ampelodesmos ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 21.151
## 2 8 22.576 3 2.8507 0.4152
lrtest(update(mb_Ampelodesmos0, ~1), mb_Ampelodesmos0)
## Likelihood ratio test
##
## Model 1: Ampelodesmos ~ 1
## Model 2: Ampelodesmos ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 8.7051
## 2 5 21.1512 3 24.892 1.626e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Ampelodesmos0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.000691 0.0297 Inf -0.023 1.0000
## winter - summer -0.264157 0.0349 Inf -7.566 <.0001
## winter - autumn -0.187964 0.0342 Inf -5.500 <.0001
## spring - summer -0.263466 0.0349 Inf -7.541 <.0001
## spring - autumn -0.187273 0.0342 Inf -5.476 <.0001
## summer - autumn 0.076192 0.0388 Inf 1.966 0.2010
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### brachypodium
mb_Brachypodium0 <- betareg(Brachypodium ~ Season,
data = items2)
mb_Brachypodium <- betareg(Brachypodium ~ Season|Season,
data = items2)
lrtest(mb_Brachypodium0, mb_Brachypodium)
## Likelihood ratio test
##
## Model 1: Brachypodium ~ Season
## Model 2: Brachypodium ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 25.981
## 2 8 29.492 3 7.0222 0.07119 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
lrtest(update(mb_Brachypodium0, ~1), mb_Brachypodium0)
## Likelihood ratio test
##
## Model 1: Brachypodium ~ 1
## Model 2: Brachypodium ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 15.892
## 2 5 25.981 3 20.18 0.0001558 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Brachypodium0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.0175 0.0200 Inf -0.877 0.8169
## winter - summer -0.1330 0.0230 Inf -5.794 <.0001
## winter - autumn -0.1199 0.0227 Inf -5.283 <.0001
## spring - summer -0.1154 0.0235 Inf -4.921 <.0001
## spring - autumn -0.1023 0.0232 Inf -4.411 0.0001
## summer - autumn 0.0131 0.0258 Inf 0.508 0.9572
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### other_graminoids
mb_Other_graminoids0 <- betareg(Other_graminoids ~ Season,
data = items2)
mb_Other_graminoids <- betareg(Other_graminoids ~ Season|Season,
data = items2)
lrtest(mb_Other_graminoids0, mb_Other_graminoids)
## Likelihood ratio test
##
## Model 1: Other_graminoids ~ Season
## Model 2: Other_graminoids ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 34.291
## 2 8 37.719 3 6.8562 0.07662 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
lrtest(update(mb_Other_graminoids0, ~1), mb_Other_graminoids0)
## Likelihood ratio test
##
## Model 1: Other_graminoids ~ 1
## Model 2: Other_graminoids ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 32.337
## 2 5 34.291 3 3.9069 0.2717
em <- emmeans(mb_Other_graminoids0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.014063 0.0109 Inf -1.288 0.5704
## winter - summer -0.020343 0.0111 Inf -1.826 0.2612
## winter - autumn -0.020747 0.0112 Inf -1.860 0.2457
## spring - summer -0.006280 0.0116 Inf -0.539 0.9495
## spring - autumn -0.006684 0.0117 Inf -0.573 0.9401
## summer - autumn -0.000404 0.0119 Inf -0.034 1.0000
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### woody
mb_Woody0 <- betareg(Woody ~ Season,
data = items2)
mb_Woody <- betareg(Woody ~ Season|Season,
data = items2)
lrtest(mb_Woody0, mb_Woody)
## Likelihood ratio test
##
## Model 1: Woody ~ Season
## Model 2: Woody ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 21.655
## 2 8 22.202 3 1.0935 0.7786
lrtest(update(mb_Woody0, ~1), mb_Woody0)
## Likelihood ratio test
##
## Model 1: Woody ~ 1
## Model 2: Woody ~ Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 4.0245
## 2 5 21.6550 3 35.261 1.073e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Woody0, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring 0.0314 0.0366 Inf 0.859 0.8261
## winter - summer 0.4076 0.0323 Inf 12.627 <.0001
## winter - autumn 0.3541 0.0336 Inf 10.529 <.0001
## spring - summer 0.3762 0.0324 Inf 11.597 <.0001
## spring - autumn 0.3227 0.0338 Inf 9.552 <.0001
## summer - autumn -0.0534 0.0290 Inf -1.840 0.2545
##
## P value adjustment: tukey method for comparing a family of 4 estimates
#### other_herbaceous
mb_Other_herbaceous0 <- betareg(Other_herbaceous ~ Season,
data = items2)
mb_Other_herbaceous <- betareg(Other_herbaceous ~ Season|Season,
data = items2)
lrtest(mb_Other_herbaceous0, mb_Other_herbaceous)
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ Season
## Model 2: Other_herbaceous ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 37.987
## 2 8 41.078 3 6.1828 0.103
lrtest(update(mb_Other_herbaceous, ~1), mb_Other_herbaceous)
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ 1 | Season
## Model 2: Other_herbaceous ~ Season | Season
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 5 33.175
## 2 8 41.078 3 15.806 0.001242 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
em <- emmeans(mb_Other_herbaceous, ~ Season)
contrast(em, "pairwise")
## contrast estimate SE df z.ratio p.value
## winter - spring -0.00165 0.01071 Inf -0.154 0.9987
## winter - summer 0.00835 0.00982 Inf 0.850 0.8303
## winter - autumn -0.02832 0.00941 Inf -3.010 0.0139
## spring - summer 0.01000 0.00671 Inf 1.489 0.4441
## spring - autumn -0.02667 0.00610 Inf -4.369 0.0001
## summer - autumn -0.03667 0.00435 Inf -8.428 <.0001
##
## P value adjustment: tukey method for comparing a family of 4 estimates
# Diet composition plot
pdieta <- dieta %>%
dplyr::select(Ampelodesmos:Other_herbaceous) %>% # subconjunt amb dieta nom?s
transmute(total = rowSums(.)) %>% # calculem abund. total per individu
bind_cols(dieta) %>% # ajuntem el total a dd
mutate(across(Ampelodesmos:Other_herbaceous, ~.x/total))
ladieta <- pivot_longer(pdieta, cols = Ampelodesmos:Other_herbaceous,
names_to = "Species",
values_to = "p_i")
ladieta$Species <- factor(ladieta$Species,
levels = c("Ampelodesmos", "Brachypodium",
"Other_graminoids", "Other_herbaceous", "Woody"),
labels = c("Ampelodesmos", "Brachypodium",
"Other poaceae", "Other herbaceous", "Woody"))
ladieta$Season <- factor(ladieta$Season,
levels = c("summer", "autumn", "winter", "spring"))
ggplot(ladieta, aes(Species, p_i)) +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.3) +
stat_summary(fun = mean, geom = "col") +
facet_wrap(~ Season, nrow = 1) +
labs(title = "Diet Composition (Potokka)", x = NULL, y = NULL) +
theme(aspect.ratio = 1, axis.text.x = element_text(angle = 70, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 14))
############ Section 3: Common or Crossbred Horses
# Load and format diet data
dieta <- read_excel("Crossbred.xlsx")
dieta$Period <- factor(dieta$Period, levels = c("start", "end"))
# Prepare compositional data using DR_data (zeros are imputed, proportions sum to 1)
items <- dieta %>% dplyr::select(Woody:Other_herbaceous) %>% DR_data()
## Warning in DR_data(.): not all rows sum up to 1 => normalization forced
## some entries are 0 or 1 => transformation forced
# Reshape data for plotting
ddpc <- dieta %>%
dplyr::select(Period) %>%
bind_cols(data.frame(unclass(items))) %>%
pivot_longer(cols = Woody:Other_herbaceous,
values_to = "pc",
names_to = "item")
# Relabel items for plotting
ddpc$item <- factor(ddpc$item,
levels = c("Brachypodium", "Other_graminoids", "Fabaceae",
"Other_herbaceous", "Woody"),
labels = c("Brachypodium", "Other poaceae", "Fabaceae",
"Other herbaceous", "Woody"))
# Ensure correct period order
ddpc$Period <- factor(ddpc$Period, levels = c("start", "end"))
# Fit null and period models
m0 <- DirichReg(items ~ 1, data = dieta)
mm <- DirichReg(items ~ Period, data = dieta)
# AIC model comparison
models <- list(Null = m0, Period = mm)
AIC_models <- sapply(models, AIC) %>% as.data.frame()
names(AIC_models) <- "AIC"
rownames(AIC_models) <- names(models)
AIC_models$K <- sapply(models, \(m) m$npar)
AIC_models$LL <- sapply(models, logLik)
AIC_models <- AIC_models[order(AIC_models$AIC), ]
AIC_models$deltaAIC <- AIC_models$AIC - AIC_models$AIC[1]
.tmp <- exp(-0.5 * AIC_models$deltaAIC)
AIC_models$weight <- .tmp / sum(.tmp)
AIC_models <- AIC_models[, c("K", "AIC", "deltaAIC", "weight", "LL")]
AIC_models$`p value` <- sapply(list(m0, mm),
\(x) anova(m0, x)$`Pr(>Chi)`[2])
print(AIC_models)
## K AIC deltaAIC weight LL p value
## Period 10 -230.0997 0.00000 1.000000e+00 125.04983 1.000000e+00
## Null 5 -148.2435 81.85621 1.679383e-18 79.12173 2.736933e-18
drop1(mm)
## Single term deletions
##
## Model:
## items ~ Period
## Df Deviance AIC LRT Pr(>Chi)
## <none> -250.10 -230.10
## Other_graminoids: Period 1 -249.80 -231.80 0.2967 0.58599
## Brachypodium: Period 1 -249.69 -231.69 0.4088 0.52259
## Fabaceae: Period 1 -237.42 -219.42 12.6779 0.00037 ***
## Other_herbaceous: Period 1 -228.16 -210.16 21.9421 2.810e-06 ***
## Woody: Period 1 -226.87 -208.87 23.2312 1.436e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Standardized residuals
res <- residuals(mm, type = "standardized")
# Boxplot of residuals by component
boxplot(res, main = "Boxplot of Deviance Residuals by Component")
# Residuals vs fitted for each component
fitted_vals <- fitted(mm)
par(mfrow = c(1, ncol(fitted_vals)))
for (i in 1:ncol(fitted_vals)) {
plot(fitted_vals[, i], res[, i],
main = colnames(fitted_vals)[i],
xlab = "Fitted", ylab = "Residuals")
abline(h = 0, col = "red")
}
# Convert DR_data back to standard data frame
items2 <- items |> unclass() |> as.data.frame() |> cbind(Period = dieta$Period)
mb_Woody0 <- betareg(Woody ~ Period, data = items2)
mb_Woody <- betareg(Woody ~ Period | Period, data = items2)
lrtest(mb_Woody0, mb_Woody) # constant dispersion model is preferred
## Likelihood ratio test
##
## Model 1: Woody ~ Period
## Model 2: Woody ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 18.515
## 2 4 19.076 1 1.1214 0.2896
lrtest(update(mb_Woody0, ~1), mb_Woody0) # Period effect is significant
## Likelihood ratio test
##
## Model 1: Woody ~ 1
## Model 2: Woody ~ Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 6.3342
## 2 3 18.5149 1 24.362 7.985e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mb_Brachypodium0 <- betareg(Brachypodium ~ Period, data = items2)
mb_Brachypodium <- betareg(Brachypodium ~ Period | Period, data = items2)
lrtest(mb_Brachypodium0, mb_Brachypodium) # constant dispersion model is preferred
## Likelihood ratio test
##
## Model 1: Brachypodium ~ Period
## Model 2: Brachypodium ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 21.480
## 2 4 22.585 1 2.2105 0.1371
lrtest(update(mb_Brachypodium0, ~1), mb_Brachypodium0) # Period effect is significant
## Likelihood ratio test
##
## Model 1: Brachypodium ~ 1
## Model 2: Brachypodium ~ Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 6.4911
## 2 3 21.4797 1 29.977 4.371e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mb_Fabaceae0 <- betareg(Fabaceae ~ Period, data = items2)
mb_Fabaceae <- betareg(Fabaceae ~ Period | Period, data = items2)
lrtest(mb_Fabaceae0, mb_Fabaceae) # variable dispersion is better
## Likelihood ratio test
##
## Model 1: Fabaceae ~ Period
## Model 2: Fabaceae ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 31.578
## 2 4 34.004 1 4.852 0.02761 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
lrtest(update(mb_Fabaceae, ~1), mb_Fabaceae) # Period effect is NOT significant
## Likelihood ratio test
##
## Model 1: Fabaceae ~ 1 | Period
## Model 2: Fabaceae ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 33.293
## 2 4 34.004 1 1.4221 0.2331
mb_Other_graminoids0 <- betareg(Other_graminoids ~ Period, data = items2)
mb_Other_graminoids <- betareg(Other_graminoids ~ Period | Period, data = items2)
lrtest(mb_Other_graminoids0, mb_Other_graminoids) # variable dispersion is better
## Likelihood ratio test
##
## Model 1: Other_graminoids ~ Period
## Model 2: Other_graminoids ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 35.027
## 2 4 37.664 1 5.2751 0.02163 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
lrtest(update(mb_Other_graminoids, ~1), mb_Other_graminoids) # Period effect is significant
## Likelihood ratio test
##
## Model 1: Other_graminoids ~ 1 | Period
## Model 2: Other_graminoids ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 30.430
## 2 4 37.664 1 14.469 0.0001425 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mb_Other_herbaceous0 <- betareg(Other_herbaceous ~ Period, data = items2)
mb_Other_herbaceous <- betareg(Other_herbaceous ~ Period | Period, data = items2)
lrtest(mb_Other_herbaceous0, mb_Other_herbaceous) # constant dispersion is preferred
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ Period
## Model 2: Other_herbaceous ~ Period | Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 3 33.825
## 2 4 34.875 1 2.0986 0.1474
lrtest(update(mb_Other_herbaceous0, ~1), mb_Other_herbaceous0) # Period effect is significant
## Likelihood ratio test
##
## Model 1: Other_herbaceous ~ 1
## Model 2: Other_herbaceous ~ Period
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 2 27.337
## 2 3 33.825 1 12.976 0.0003154 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ggplot(ddpc, aes(item, pc)) +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.3) +
stat_summary(fun = mean, geom = "col") +
facet_wrap(~ Period, nrow = 1) +
labs(title = "Diet Composition by Period", x = NULL, y = NULL) +
theme(aspect.ratio = 1,
axis.text.x = element_text(angle = 70, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 14))
