library(tidyverse)
library(wesanderson) # Palette de couleur
library(aspe) # Traitement de la base aspe
library(mgcv) # modele GAMMs
library(gratia)
library(patchwork)
library(lme4)
library(RVAideMemoire)
library(glmmTMB)
library(car) # fonction Anova()
library(ggh4x)
library(gstat)#semi_variogramme
library(mapview)
library(COGiter)
library(sf)
library(ggplotify)
library(ggpubr)
library(gstat)# For semivariogram
load(file = "../processed_data/selection_especes.rda")
load(file = "../processed_data/selection_pop_ope.rda")
load(file = "../processed_data/donnees_densite_eff_abs.rda")
load(file = "../processed_data/selection_pop_ope.rda")
load(file = "../processed_data/selection_pop_ope_carte.rda")
rdata_tables <- misc_nom_dernier_fichier(
repertoire = "../../../../Liste_rouge_BFC/raw_data",
pattern = "^tables")
load(rdata_tables) # Chargement des données
pal <- wes_palette("AsteroidCity1")
Script : 45_GAMM_question
L’objectif principal de l’étude est d’évaluer les tendances démographiques des espèces de poissons d’eau douce à l’échelle de la région Bourgogne Franche-comté. Des séries chronologiques longues enregistrant plus d’une dizaine d’années ou 3 générations (critère A UICN) de données seront utilisées (sur un total disponible d’une vingtaine d’années). Ce travail s’inscrit dans la perspective de la création de la Liste rouge régionale des poissons d’eau douce de Bourgogne Franche-Comté et compte une trentaine d’espèces à évaluer.
L’OFB a mis en place depuis 1990 des réseaux de suivi temporel de l’état des milieux aquatiques à partir des peuplements de poissons. Les échantillonnages sont réalisés tous les ans ou tout les deux ans en fonction des réseaux pluriannuels des stations identiques selon deux protocoles distincts : - pêche par points (partielle) - pêche complète
L’ensemble des données sont stocké dans la base de données aspe de l’OFB.
Les tendances temporelles seront estimées par une analyse statistique de Modèles Additifs Généralisé Mixtes (GAMMs), de Modèles Linéaires Généralisé Mixtes (GLMM) ou de Zero-Inflated Poisson GLM (ZIPGLMM) en fonction de l’ajustement des modèles aux données.
Pour répondre à la question initiale, les modèles vont se construire à partir des variables suivantes :
La variable réponse : valeur, effectif des poissons variable quantitative discrète bornée
Les variables explicatives :
les co-variables :
annee, variable quantitative discrète bornée
ope_surface_calculee, la surface pêchée variable quantitative continue bornée
les facteurs :
pro_libelle, les protocoles utilisés (2 modalitées) variable qualitative nominal
sta_id, les stations d’échantillonages (163 modalitées) variable qualitative nominal
Comme les données sont appariées, un facteur aléatoire (1|sta_id) sera intégré dans tous les modèles.Les modèles seront de la forme suivante :
modele <- effectif ~ annee + protocole + surface + (1|station)
Le coefficient prédit par les modèles permettra d’estimer la tendance temporelle.
Les GAMMs sont utilisés en considérant que les relations entre les variables ne sont pas forcément linéaires. Par exemple, les effectifs fluctuent entre les années par un échantillonnage bi-annelles pour certaines stations et une grande variabilité annuelle des effectifs conditionnés par les conditions lors de la période de reproduction.
Les GLMM sont utilisés pour améliorer l’ajustement du modèle au données.
Les modèles Zero-inflated sont utilisés pour corrigé la sur-dispersion des résidus
ope_selection %>% # Représentation graphique des stations sélectionnées et des types de pêche associées
ggplot(
aes(
x = as.character(pop_libelle),
y = annee,
fill = pro_libelle
),
legend.background = element_rect(fill = "#ffffff")
) +
scale_fill_manual(values = pal) +
geom_tile() +
labs(
title = "Les points de prélèvements sélectionnés et les types de pêches associées",
subtitle = "Région Bourgogne-Franche-Comté",
x = "",
y = "Années",
fill = "Type de pêche"
) +
theme_light(base_size = 18) +
theme(
panel.grid.major = element_line(color = "#ffffff", size = 0.1),
panel.grid.minor = element_line(color = "#ffffff"),
panel.background = element_rect(fill = "#faf0e6"),
legend.position = "bottom",
legend.text = element_text(size = 18),
# taille labels pro_libelle
legend.title = element_text(size = 15),
# taille titre légende
axis.text.y = element_text(size = 16) # taille noms stations
) +
coord_flip() +
scale_y_continuous(breaks = seq(min(ope_selection$annee), max(ope_selection$annee), by = 3))
mapview(
list(buffer, mes_depts),
# Visualisation de l'effort de pêche
layer.name = c("Buffer_1_km", "Bourgogne-Franche-Comté"),
col.regions = list("darkseagreen4", "darkseagreen1")
) +
mapview(
sta_id_ope_selection,
layer.name = "Nombre operation par station",
# size_var = "nb_ope_par_sta",
# cex = "sta_id",
cex = "nb_ope_par_sta",
lwd = 0.2,
zcol = "nb_ope_par_sta",
# col.regions = "#D693E0",
alpha = 0.8,
legend = TRUE,
labels = list(text = sta_id_ope_selection$nb_ope_par_sta, cex = 1.5)
)
# Pour creer la colonne periode : on renseigne le début de période souhaiter : ici 2007
annee_debut_periode <- 2007
# preparer la table pour jointure
ope_selection <- ope_selection %>%
dplyr::select(ope_id, pop_id, sta_id)
# Ajout des coordonnées pour jointure avec df pour future analyse autocorrelation spatiale
coord_sta_id <- point_prelevement %>%
filter(pop_id %in% pop_serie_tempo) %>%
rename(x = pop_coordonnees_x, y = pop_coordonnees_y) %>%
select(pop_id, x, y)
esp_ope_selection_graph <- esp_ope_selection %>%
mef_ajouter_type_protocole() %>%
mef_ajouter_ope_date() %>%
left_join(ope_selection, by = "ope_id") %>%
rename(valeur = lop_effectif, annee = annee.x) %>%
left_join(coord_sta_id, by = "pop_id") %>%
mutate(
valeur = as.numeric(valeur) ,
annee = as.numeric(annee),
ope_surface_calculee = as.numeric(ope_surface_calculee) ,
pro_libelle = as.factor(pro_libelle),
pop_id = as.factor(pop_id),
sta_id = as.factor(sta_id),
indicateur = "effectif_total"
) %>% # creation d'une colonne pour la période (ex : 2007-2008)
mutate(periode = {
debut <- floor((annee - annee_debut_periode) / 2) * 2 + annee_debut_periode
paste0(debut)
}, periode = as.numeric(periode)) %>%
mutate(julian = lubridate::yday(ope_date)) %>% # Ajout de la date de pêche codée de 1 à 365
select(
ope_id,
valeur,
esp_code_alternatif,
annee,
ope_surface_calculee,
pro_libelle,
pop_id,
sta_id,
indicateur,
periode,
x,
y,
ope_date,
julian
)
# Creation du df par especes avec effectif total - periode
total_valeur_esp <- esp_ope_selection_graph %>%
group_by(periode, esp_code_alternatif, indicateur) %>%
summarise(effectif_total = sum(valeur), .groups = "drop") %>%
select(esp_code_alternatif, periode, effectif_total, indicateur)
# Creation du df par especes avec effectif total - annee
total_valeur_esp_an <- esp_ope_selection_graph %>%
group_by(annee, esp_code_alternatif, indicateur) %>%
summarise(effectif_total = sum(valeur), .groups = "drop") %>%
select(esp_code_alternatif, annee, effectif_total, indicateur)
Selection de l’espèce à traiter : ici la Truite fario “TRF”
# Selection de lespèce cible pour le graphique
total_valeur_esp_trf <- total_valeur_esp %>%
filter(esp_code_alternatif == "TRF")
# Selection de lespèce cible pour le graphique
total_valeur_esp_trf_an <- total_valeur_esp_an %>%
filter(esp_code_alternatif == "TRF")
# Selecetion de l'espèce pour les analyses
esp_ope_selection_trf <- esp_ope_selection_graph %>%
filter(esp_code_alternatif == "TRF")
plot_trf_annee <- ggplot(total_valeur_esp_trf_an, aes(x = annee, y = effectif_total)) +
facet_wrap2(
esp_code_alternatif ~ indicateur,
ncol = 3,
scales = "free_y",
axes = "all",
trim_blank = T
) +
geom_point(shape = 21, size = 2) +
geom_line(linetype = 3, linewidth = 0.5) +
labs(x = "Années", y = "Effectif total") +
geom_smooth(method = "lm", color = "darkred") +
# geom_smooth(method = "loess",
# se = F,
# color = "darkred") + # Add loess trend lines
theme(
strip.background = element_rect(color = "grey85", fill = "grey85"),
legend.position = "bottom",
panel.background = element_rect(fill = "grey95"),
panel.grid.major = element_line(color = "#faffff", size = 0.1),
panel.grid.minor = element_line(color = "#faffff")
)
plot_trf_periode <- ggplot(total_valeur_esp_trf, aes(x = periode, y = effectif_total)) +
facet_wrap2(
esp_code_alternatif ~ indicateur,
ncol = 3,
scales = "free_y",
axes = "all",
trim_blank = T
) +
geom_point(shape = 21, size = 2) +
geom_line(linetype = 3, linewidth = 0.5) +
labs(x = "Période", y = "Effectif total") +
geom_smooth(method = "lm", color = "darkred") +
# geom_smooth(method = "loess",
# se = F,
# color = "darkred") + # Add loess trend lines
theme(
strip.background = element_rect(color = "grey85", fill = "grey85"),
legend.position = "bottom",
panel.background = element_rect(fill = "grey95"),
panel.grid.major = element_line(color = "#faffff", size = 0.1),
panel.grid.minor = element_line(color = "#faffff")
)
plot_trf <- ggarrange(
plot_trf_annee,
plot_trf_periode,
ncol = 2,
nrow = 1,
labels = c(
"Effectif en fonction de l'annee",
"Effectif en fonction de la periode (n : n+1)"
),
font.label = list(
size = 14,
color = "darkred",
face = "bold",
family = NULL
),
hjust = -0.5,
vjust = 1.9,
align = c("none", "h", "v", "hv")
)
plot_trf
mod_gamm_1.0 <- gamm(
valeur ~ s(annee, k = 15) + s(ope_surface_calculee, k = 15) + pro_libelle,
random = list(sta_id = ~ 1),
data = esp_ope_selection_trf,
family = poisson(link = "log"),
method = "REML"
)
##
## Maximum number of PQL iterations: 20
mod_gamm_1.1 <- gamm(
valeur ~ s(annee, k = 15) + s(ope_surface_calculee, k = 15) + pro_libelle,
random = list(sta_id = ~ 1),
data = esp_ope_selection_trf,
family = poisson(link = "identity"),
method = "REML"
)
##
## Maximum number of PQL iterations: 20
mod_gamm_1.2 <- gamm(
valeur ~ s(annee, k = 15) + s(ope_surface_calculee, k = 15) + pro_libelle,
random = list(sta_id = ~ 1),
data = esp_ope_selection_trf,
family = poisson(link = "sqrt"),
method = "REML"
)
##
## Maximum number of PQL iterations: 20
mod_gamm_1.3 <- gam(
valeur ~ s(annee) + s(ope_surface_calculee) + pro_libelle+ s(x,y),
data = esp_ope_selection_trf,
family = poisson(link = "log"),
method = "REML"
)
acf_mod_gamm_1.0 <- as.ggplot(~ acf(residuals(mod_gamm_1.0$lme, type = "normalized"), lag.max = 20))
acf_mod_gamm_1.1 <- as.ggplot(~ acf(residuals(mod_gamm_1.1$lme, type = "normalized"), lag.max = 20))
acf_mod_gamm_1.2 <- as.ggplot(~ acf(residuals(mod_gamm_1.2$lme, type = "normalized"), lag.max = 20))
ggarrange(
acf_mod_gamm_1.0,
acf_mod_gamm_1.1,
acf_mod_gamm_1.2,
ncol = 3,
nrow = 1,
labels = c("acf_mod_gamm_1.0", "acf_mod_gamm_1.1", "acf_mod_gamm_1.2"),
font.label = list(
size = 14,
color = "darkred",
face = "bold",
family = NULL
),
hjust = -0.1,
vjust = 1.6,
align = c("none", "h", "v", "hv")
)
ggplot(esp_ope_selection_trf, aes(x = x, y = y, size = valeur)) +
geom_point() +
coord_fixed()
ggplot(esp_ope_selection_trf, aes(x = annee, y = valeur)) +
geom_point()
var <- variogram(valeur ~ annee + ope_surface_calculee, locations = ~ x+y, data = esp_ope_selection_trf)
var
## np dist gamma dir.hor dir.ver id
## 1 4129839 453.4066 147.71964 0 0 var1
## 2 2762738 12145.1806 131.79681 0 0 var1
## 3 4770940 21150.2871 112.84181 0 0 var1
## 4 3535669 29747.7735 205.35159 0 0 var1
## 5 4389037 37930.6049 153.84611 0 0 var1
## 6 5396952 46010.7995 213.62465 0 0 var1
## 7 4486533 55613.6147 169.80796 0 0 var1
## 8 4881343 63031.0201 68.27284 0 0 var1
## 9 4928812 71676.2461 99.59569 0 0 var1
## 10 3457271 79701.0882 88.95981 0 0 var1
## 11 3521340 87739.5354 61.03049 0 0 var1
## 12 6041220 95468.6622 145.60051 0 0 var1
## 13 5885089 104588.3740 102.31949 0 0 var1
## 14 5597444 113009.1044 85.78694 0 0 var1
## 15 5834463 121683.9966 47.35979 0 0 var1
plot(var, col= "black")
show.vgms(models = c("Exp", # Exponential model
"Sph", # Spherical model
"Gau", # Gaussian model
"Nug"), # Nugget model
nugget = 50)
vfit <- fit.variogram(var, vgm(c("Exp", "Gau", "Sph")))
vfit
## model psill range
## 1 Nug 148.1882 0.00
## 2 Sph 0.0000 40561.33
# Did the model-fitting process converge successfully?
# This is not guaranteed for nonlinear models.
attributes(vfit)$singular
## [1] TRUE
# For convenience, use show.vgms() to calculate the
# predicted values for our fitted model
fitted <-show.vgms(min = min(var$dist),
max = max(var$dist),
models ="Sph",
range = vfit$range[2],
sill = vfit$psill[2],
nugget = vfit$psill[1],
plot = FALSE)
# Now we can easily plot this against the observed data
ggplot(var, aes(dist, gamma)) +
geom_point() +
geom_line(data = fitted,
aes(distance, semivariance),
linetype = 2)
# plot(var, vfit, col = "black")
appraise(mod_gamm_1.0$gam)
appraise(mod_gamm_1.1$gam)
appraise(mod_gamm_1.2$gam)
k.check(mod_gamm_1.0$gam)
## k' edf k-index p-value
## s(annee) 14 13.90401 0.9991631 0.4300
## s(ope_surface_calculee) 14 13.53667 0.9161402 0.0025
k.check(mod_gamm_1.1$gam)
## k' edf k-index p-value
## s(annee) 14 13.88207 1.006524 0.7150
## s(ope_surface_calculee) 14 12.04178 0.964481 0.0375
k.check(mod_gamm_1.2$gam)
## k' edf k-index p-value
## s(annee) 14 13.90506 0.9401616 0.000
## s(ope_surface_calculee) 14 12.88747 0.9591719 0.005
-> Verifier le k’/edf : edf doit être << k’. Si edf est proche de k’, cela signifie qu’il faut augmenter k. Cependant, comme on travaille sur 20 ans on ne peut pas dépasser k = 19.
concurvity(mod_gamm_1.0$gam)
## para s(annee) s(ope_surface_calculee)
## worst 0.5097488 0.12571435 0.63851587
## observed 0.5097488 0.03634524 0.05918667
## estimate 0.5097488 0.06501472 0.11567597
concurvity(mod_gamm_1.1$gam)
## para s(annee) s(ope_surface_calculee)
## worst 0.5097488 0.12571435 0.63851587
## observed 0.5097488 0.03486796 0.07327614
## estimate 0.5097488 0.06501472 0.11567597
concurvity(mod_gamm_1.2$gam)
## para s(annee) s(ope_surface_calculee)
## worst 0.5097488 0.12571435 0.63851587
## observed 0.5097488 0.03557414 0.06114753
## estimate 0.5097488 0.06501472 0.11567597
draw(mod_gamm_1.0, residuals = T)
draw(mod_gamm_1.1, residuals = T)
draw(mod_gamm_1.2, residuals = T)
draw(mod_gamm_1.0, residuals = F)
draw(mod_gamm_1.1, residuals = F)
draw(mod_gamm_1.2, residuals = F)
summary(esp_ope_selection_graph)
## ope_id valeur esp_code_alternatif annee
## Min. :11207 Min. : 1.000 Length:142523 Min. :2007
## 1st Qu.:36802 1st Qu.: 1.000 Class :character 1st Qu.:2011
## Median :38261 Median : 1.000 Mode :character Median :2016
## Mean :53164 Mean : 7.957 Mean :2016
## 3rd Qu.:84312 3rd Qu.: 1.000 3rd Qu.:2020
## Max. :96052 Max. :3511.000 Max. :2025
##
## ope_surface_calculee pro_libelle
## Min. : 52.0 Pêche complète à un ou plusieurs passages:55006
## 1st Qu.: 937.5 Pêche partielle par points (grand milieu):87517
## Median : 937.5
## Mean : 983.8
## 3rd Qu.:1250.0
## Max. :2783.0
##
## pop_id sta_id indicateur periode
## 33562 : 2829 8884 : 2829 Length:142523 Min. :2007
## 35119 : 2525 9166 : 2525 Class :character 1st Qu.:2011
## 69061 : 2250 19535 : 2250 Mode :character Median :2015
## 14895981: 2058 4331694: 2058 Mean :2015
## 67287 : 2035 18756 : 2035 3rd Qu.:2019
## 81644 : 2032 24171 : 2032 Max. :2025
## (Other) :128794 (Other):128794
## x y ope_date julian
## Min. :691396 Min. :6566885 Min. :2007-05-31 09:30:01 Min. :102
## 1st Qu.:774154 1st Qu.:6638880 1st Qu.:2011-08-31 13:30:01 1st Qu.:180
## Median :857024 Median :6679085 Median :2016-07-07 14:00:01 Median :240
## Mean :847751 Mean :6678175 Mean :2016-04-12 21:58:20 Mean :225
## 3rd Qu.:918183 3rd Qu.:6718963 3rd Qu.:2020-07-03 09:00:01 3rd Qu.:266
## Max. :998675 Max. :6798620 Max. :2025-10-24 08:15:01 Max. :314
##
mod_glmm_1.0 <- glmer(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 |sta_id),
data = esp_ope_selection_trf,
family = poisson(link = "log")
)
mod_glmm_1.1 <- glmer(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 |sta_id),
data = esp_ope_selection_trf,
family = poisson(link = "identity")
)
mod_glmm_1.2 <- glmer(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 |sta_id),
data = esp_ope_selection_trf,
family = poisson(link = "sqrt")
)
mod_glmm_1.3 <- glmer(
valeur ~ annee + ope_surface_calculee + pro_libelle + julian + (1 |sta_id),
data = esp_ope_selection_trf,
family = poisson(link = "log")
)
res_mod_glmm_1.0 <- as.ggplot(~ plotresid(mod_glmm_1.0))
res_mod_glmm_1.1 <- as.ggplot(~ plotresid(mod_glmm_1.1))
res_mod_glmm_1.2 <- as.ggplot(~ plotresid(mod_glmm_1.2))
ggarrange(
res_mod_glmm_1.0,
res_mod_glmm_1.1,
res_mod_glmm_1.2,
ncol = 2,
nrow = 2,
labels = c("log", "identity", "sqrt"),
font.label = list(
size = 13,
color = "darkred",
face = "bold",
family = NULL
),
hjust = -0.1,
vjust = 1.6,
align = c("none", "h", "v", "hv")
)
overdisp.glmer(mod_glmm_1.0)
## Residual deviance: 72030.05 on 16123 degrees of freedom (ratio: 4.468)
overdisp.glmer(mod_glmm_1.1)
## Residual deviance: 72097.968 on 16123 degrees of freedom (ratio: 4.472)
overdisp.glmer(mod_glmm_1.2)
## Residual deviance: 72067.698 on 16123 degrees of freedom (ratio: 4.47)
Si les conditions d’applications du modèle sont bien respectées :
# Anova(mod_glmm_1.0)
# Anova(mod_glmm_1.1)
# Anova(mod_glmm_1.2)
# summary(mod_glmm_1.0)
# summary(mod_glmm_1.1)
# summary(mod_glmm_1.2)
Si problème de sur ou sous-dispersion : esssayer une Quasi binomiale négative.
# mod_glmm_qbn <- glmer.nb(valeur ~ annee + ope_surface_calculee + pro_libelle+ (1|sta_id), data = esp_ope_selection_trf, family = poisson(link = "log")
# )
mod_zi_1.0 <- glmmTMB(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 |
sta_id) ,
data = esp_ope_selection_trf,
family = poisson(link = "log"),
ziformula = ~ 1
)
mod_zi_1.1 <- glmmTMB(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id) ,
family = nbinom2(link = "log"),
data = esp_ope_selection_trf,
ziformula = ~ 1
)
mod_zi_1.2 <- glmmTMB(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id) ,
family = truncated_poisson(link = "log"),
data = esp_ope_selection_trf,
ziformula = ~ 1
)
mod_zi_1.3 <- glmmTMB(
valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id) ,
family = truncated_nbinom2(link = "log"),
data = esp_ope_selection_trf,
ziformula = ~ 1
)
On selectionne à l’aide du critère AIC le meilleur modèle c’est à dire le modèle avec le plus petit AIC.
AIC(mod_zi_1.0, mod_zi_1.1, mod_zi_1.2, mod_zi_1.3)
## df AIC
## mod_zi_1.0 6 106394.25
## mod_zi_1.1 7 57702.92
## mod_zi_1.2 6 93880.00
## mod_zi_1.3 7 25950.06
res_mod_zi_1.0 <- as.ggplot(~ plotresid(mod_zi_1.0))
res_mod_zi_1.1 <- as.ggplot(~ plotresid(mod_zi_1.1))
res_mod_zi_1.2 <- as.ggplot(~ plotresid(mod_zi_1.2))
res_mod_zi_1.3 <- as.ggplot(~ plotresid(mod_zi_1.3))
ggarrange(
res_mod_zi_1.0,
res_mod_zi_1.1,
res_mod_zi_1.2,
res_mod_zi_1.3,
ncol = 2,
nrow = 2,
labels = c("poisson", "nbinom2", "truncated_poisson", "truncated_nbinom2"),
font.label = list(
size = 13,
color = "darkred",
face = "bold",
family = NULL
),
hjust = -0.1,
vjust = 1.6,
align = c("none", "h", "v", "hv")
)
summary(mod_zi_1.0)
## Family: poisson ( log )
## Formula:
## valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id)
## Zero inflation: ~1
## Data: esp_ope_selection_trf
##
## AIC BIC logLik -2*log(L) df.resid
## 106394.2 106440.4 -53191.1 106382.2 16122
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev.
## sta_id (Intercept) 0.1392 0.3731
## Number of obs: 16128, groups: sta_id, 100
##
## Conditional model:
## Estimate Std. Error
## (Intercept) -1.488e+01 2.331e+00
## annee 7.726e-03 1.157e-03
## ope_surface_calculee -3.717e-04 3.449e-05
## pro_libellePêche partielle par points (grand milieu) -8.347e-02 8.626e-02
## z value Pr(>|z|)
## (Intercept) -6.382 1.75e-10 ***
## annee 6.679 2.40e-11 ***
## ope_surface_calculee -10.777 < 2e-16 ***
## pro_libellePêche partielle par points (grand milieu) -0.968 0.333
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Zero-inflation model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -21.38 345.67 -0.062 0.951
summary(mod_zi_1.1)
## Family: nbinom2 ( log )
## Formula:
## valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id)
## Zero inflation: ~1
## Data: esp_ope_selection_trf
##
## AIC BIC logLik -2*log(L) df.resid
## 57702.9 57756.7 -28844.5 57688.9 16121
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev.
## sta_id (Intercept) 0.1296 0.36
## Number of obs: 16128, groups: sta_id, 100
##
## Dispersion parameter for nbinom2 family (): 1.3
##
## Conditional model:
## Estimate Std. Error
## (Intercept) -2.016e+01 4.677e+00
## annee 1.031e-02 2.330e-03
## ope_surface_calculee -2.233e-04 6.230e-05
## pro_libellePêche partielle par points (grand milieu) -1.271e-01 9.028e-02
## z value Pr(>|z|)
## (Intercept) -4.311 1.63e-05 ***
## annee 4.424 9.67e-06 ***
## ope_surface_calculee -3.584 0.000338 ***
## pro_libellePêche partielle par points (grand milieu) -1.408 0.159223
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Zero-inflation model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -22.49 603.53 -0.037 0.97
summary(mod_zi_1.2)
## Family: truncated_poisson ( log )
## Formula:
## valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id)
## Zero inflation: ~1
## Data: esp_ope_selection_trf
##
## AIC BIC logLik -2*log(L) df.resid
## 93880.0 93926.1 -46934.0 93868.0 16122
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev.
## sta_id (Intercept) 1.567 1.252
## Number of obs: 16128, groups: sta_id, 100
##
## Conditional model:
## Estimate Std. Error
## (Intercept) -2.983e+01 4.645e+00
## annee 1.462e-02 2.280e-03
## ope_surface_calculee -5.330e-04 4.205e-05
## pro_libellePêche partielle par points (grand milieu) -2.358e-01 2.845e-01
## z value Pr(>|z|)
## (Intercept) -6.421 1.35e-10 ***
## annee 6.413 1.42e-10 ***
## ope_surface_calculee -12.675 < 2e-16 ***
## pro_libellePêche partielle par points (grand milieu) -0.829 0.407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Zero-inflation model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -21.98 467.81 -0.047 0.963
summary(mod_zi_1.3)
## Family: truncated_nbinom2 ( log )
## Formula:
## valeur ~ annee + ope_surface_calculee + pro_libelle + (1 | sta_id)
## Zero inflation: ~1
## Data: esp_ope_selection_trf
##
## AIC BIC logLik -2*log(L) df.resid
## 25950.1 26003.9 -12968.0 25936.1 16121
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev.
## sta_id (Intercept) 2.099 1.449
## Number of obs: 16128, groups: sta_id, 100
##
## Dispersion parameter for truncated_nbinom2 family (): 1.42e-10
##
## Conditional model:
## Estimate Std. Error
## (Intercept) -1.117e+02 1.143e+03
## annee 4.413e-02 4.071e-03
## ope_surface_calculee -5.982e-04 1.419e-04
## pro_libellePêche partielle par points (grand milieu) -3.033e-01 3.394e-01
## z value Pr(>|z|)
## (Intercept) -0.098 0.922
## annee 10.840 < 2e-16 ***
## ope_surface_calculee -4.216 2.48e-05 ***
## pro_libellePêche partielle par points (grand milieu) -0.894 0.371
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Zero-inflation model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -24.53 1671.66 -0.015 0.988
Si les conditions d’applications du modèle sont bien respectées :
Anova(mod_zi_1.0)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: valeur
## Chisq Df Pr(>Chisq)
## annee 44.6121 1 2.402e-11 ***
## ope_surface_calculee 116.1520 1 < 2.2e-16 ***
## pro_libelle 0.9363 1 0.3332
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Anova(mod_zi_1.1)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: valeur
## Chisq Df Pr(>Chisq)
## annee 19.5747 1 9.674e-06 ***
## ope_surface_calculee 12.8460 1 0.0003382 ***
## pro_libelle 1.9816 1 0.1592227
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Anova(mod_zi_1.2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: valeur
## Chisq Df Pr(>Chisq)
## annee 41.1325 1 1.423e-10 ***
## ope_surface_calculee 160.6651 1 < 2.2e-16 ***
## pro_libelle 0.6867 1 0.4073
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Anova(mod_zi_1.3)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: valeur
## Chisq Df Pr(>Chisq)
## annee 117.5005 1 < 2.2e-16 ***
## ope_surface_calculee 17.7768 1 2.484e-05 ***
## pro_libelle 0.7988 1 0.3714
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Simpson, G. L., (2024). gratia: An R package for exploring generalized additive models. Journal of Open Source Software, 9(104), 6962, https://doi.org/10.21105/joss.06962