Cette étude porte sur l’analyse et la prévision des ventes mensuelles de liqueur aux États-Unis sur la période 1970-1980. Les données représentent les ventes en millions de dollars, constituant une série temporelle de 132 observations mensuelles.
Notre analyse vise à :
Notre approche comprend quatre étapes principales :
# Code de chargement des données
liquor_data <- c(
# 1970
580,514,555,563,627,596,632,639,577,611,639,875,
# 1971
650,594,650,668,712,731,779,712,708,738,758,1073,
# 1972
669,652,743,709,751,774,803,760,749,757,779,1066,
# 1973
734,707,785,762,838,876,878,871,807,834,877,1216,
# 1974
789,744,827,831,895,889,955,983,976,929,989,1294,
# 1975
860,799,899,866,1016,978,1042,1026,944,1002,1009,1368,
# 1976
908,849,916,958,1008,1033,1129,1019,984,1045,1049,1459,
# 1977
910,927,981,1011,1041,1080,1138,1072,1033,1072,1111,1591,
# 1978
950,932,1049,1021,1097,1151,1194,1174,1160,1135,1209,1692,
# 1979
1071,1044,1158,1122,1209,1334,1360,1368,1297,1283,1375,1974,
# 1980
1294,1258,1301,1297,1425,1378,1429,1452,1305,1377,1439,1958
)
# Conversion en série temporelle
liquor_ts <- ts(liquor_data, start=c(1970,1), frequency=12)
# Division train/test
n <- length(liquor_ts)
n_test <- 12
train_set <- window(liquor_ts, end=c(1979,12))
test_set <- window(liquor_ts, start=c(1980,1))
# Graphique de la série complète
plot(liquor_ts,
main="Ventes mensuelles de liqueur (1970-1980)",
ylab="Ventes (millions $)",
xlab="Année")
La série temporelle des ventes de liqueur présente plusieurs caractéristiques importantes :
par(mfrow=c(1,2))
acf(train_set, main="ACF - Série originale", lag.max=36)
pacf(train_set, main="PACF - Série originale", lag.max=36)
par(mfrow=c(1,1))
L’analyse des fonctions d’autocorrélation nous révèle plusieurs caractéristiques importantes :
Ces observations renforcent les conclusions précédentes sur la non-stationnarité de la série et soulignent la nécessité de :
# Décomposition additive de la série
decomp <- decompose(liquor_ts)
plot(decomp)
La décomposition de la série nous révèle :
# Boxplot mensuel
boxplot(liquor_ts ~ cycle(liquor_ts),
main="Distribution des ventes par mois",
xlab="Mois",
ylab="Ventes (millions $)")
# Moyennes mensuelles
monthly_means <- tapply(train_set, cycle(train_set), mean)
barplot(monthly_means,
main="Moyenne des ventes par mois",
xlab="Mois",
ylab="Ventes moyennes")
L’analyse mensuelle révèle :
library(tseries)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
# Test ADF sur la série originale
adf_result <- adf.test(train_set)
## Warning in adf.test(train_set): p-value smaller than printed p-value
print(paste("Test ADF p-value:", round(adf_result$p.value, 4)))
## [1] "Test ADF p-value: 0.01"
# Analyse de la variance
var_by_year <- tapply(train_set, floor(time(train_set)), var)
print("Variance par année:")
## [1] "Variance par année:"
print(round(var_by_year, 2))
## 1970 1971 1972 1973 1974 1975 1976 1977
## 8060.97 14286.99 10762.06 16790.02 19911.90 20631.17 23907.48 30560.99
## 1978 1979
## 37922.73 58880.27
Les tests de stationnarité indiquent :
L’analyse exploratoire met en évidence plusieurs points cruciaux pour la modélisation :
Cette section présente les différentes transformations appliquées à notre série temporelle pour la rendre stationnaire, une condition essentielle pour la modélisation.
# Transformation logarithmique
log_train <- log(train_set)
# Comparaison visuelle
par(mfrow=c(1,2))
plot(train_set, main="Série originale", ylab="Ventes (millions $)")
plot(log_train, main="Série logarithmique", ylab="Log(Ventes)")
par(mfrow=c(1,1))
library(forecast)
# Test de Box-Cox pour confirmer le choix de la transformation
lambda <- BoxCox.lambda(train_set)
print(paste("Valeur optimale de lambda:", round(lambda,4)))
## [1] "Valeur optimale de lambda: -0.2622"
La transformation logarithmique est appliquée pour plusieurs raisons :
On voit que la variabilité a été diminuée. Maintenant on applique une première différentiabilité pour éliminer l’effet de tendance.
library(tseries)
# D'abord nous appliquons la différenciation régulière sur la série logarithmique
diff_reg_train <- diff(log_train, lag=1)
# Visualisation comparative
par(mfrow=c(2,1))
plot(log_train, main="Série logarithmique", ylab="Log(Ventes)")
plot(diff_reg_train, main="Après différenciation régulière (lag=1)", ylab="Différence première")
par(mfrow=c(1,1))
# Examinons les autocorrélations après la différenciation régulière
par(mfrow=c(1,2))
acf(diff_reg_train, main="ACF - Après diff. régulière")
pacf(diff_reg_train, main="PACF - Après diff. régulière")
par(mfrow=c(1,1))
# Test de stationnarité
print("Test ADF après différenciation régulière:")
## [1] "Test ADF après différenciation régulière:"
adf.test(diff_reg_train)
## Warning in adf.test(diff_reg_train): p-value smaller than printed p-value
##
## Augmented Dickey-Fuller Test
##
## data: diff_reg_train
## Dickey-Fuller = -8.4793, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary
La différenciation régulière (lag=1) nous montre que :
# Appliquons maintenant la différenciation saisonnière
diff_train <- diff(diff_reg_train, lag=12)
# Visualisation des trois étapes
par(mfrow=c(3,1))
plot(log_train, main="Série logarithmique", ylab="Log(Ventes)")
plot(diff_reg_train, main="Après différenciation régulière", ylab="Diff. régulière")
plot(diff_train, main="Après différenciation saisonnière", ylab="Diff. finale")
par(mfrow=c(1,1))
# ACF et PACF de la série finale
par(mfrow=c(1,2))
acf(diff_train, main="ACF - Série finalement transformée")
pacf(diff_train, main="PACF - Série finalement transformée")
par(mfrow=c(1,1))
library(tseries)
# Test final de stationnarité
print("Test ADF après les deux différenciations:")
## [1] "Test ADF après les deux différenciations:"
adf.test(diff_train)
## Warning in adf.test(diff_train): p-value smaller than printed p-value
##
## Augmented Dickey-Fuller Test
##
## data: diff_train
## Dickey-Fuller = -6.5026, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary
L’application successive des différenciations nous permet d’observer :
La structure d’autocorrélation finale suggère un modèle SARIMA avec :
Ces transformations forment la base de notre modélisation SARIMA à venir.
La modélisation SARIMA (Seasonal ARIMA) est particulièrement adaptée à notre série qui présente à la fois une tendance et une saisonnalité marquée.
Après nos transformations précédentes (logarithme et différenciations), nous pouvons spécifier un modèle \(SARIMA(p,d,q)(P,D,Q)_{12}\) où :
# Utilisation d'auto.arima pour une première suggestion
auto_sarima <- auto.arima(log_train,
seasonal=TRUE,
stepwise=TRUE,
approximation=FALSE,
trace=TRUE)
##
## ARIMA(2,1,2)(1,1,1)[12] : -397.9016
## ARIMA(0,1,0)(0,1,0)[12] : -344.8588
## ARIMA(1,1,0)(1,1,0)[12] : -381.2833
## ARIMA(0,1,1)(0,1,1)[12] : -403.3925
## ARIMA(0,1,1)(0,1,0)[12] : -383.3013
## ARIMA(0,1,1)(1,1,1)[12] : -401.9538
## ARIMA(0,1,1)(0,1,2)[12] : -401.9948
## ARIMA(0,1,1)(1,1,0)[12] : -394.3947
## ARIMA(0,1,1)(1,1,2)[12] : -399.7934
## ARIMA(0,1,0)(0,1,1)[12] : -369.0421
## ARIMA(1,1,1)(0,1,1)[12] : -401.8087
## ARIMA(0,1,2)(0,1,1)[12] : -402.0379
## ARIMA(1,1,0)(0,1,1)[12] : -392.5316
## ARIMA(1,1,2)(0,1,1)[12] : -399.9652
##
## Best model: ARIMA(0,1,1)(0,1,1)[12]
# Affichage du modèle sélectionné
print("Modèle sélectionné par auto.arima :")
## [1] "Modèle sélectionné par auto.arima :"
print(auto_sarima)
## Series: log_train
## ARIMA(0,1,1)(0,1,1)[12]
##
## Coefficients:
## ma1 sma1
## -0.6161 -0.6587
## s.e. 0.0749 0.1170
##
## sigma^2 = 0.001217: log likelihood = 204.81
## AIC=-403.63 AICc=-403.39 BIC=-395.61
Le modèle auto.arima suggère un \(SARIMA(0,1,1)(0,1,1)_{12}\), ce qui signifie :
Nous allons comparer plusieurs spécifications :
# Estimation des modèles candidats
sarima1 <- Arima(log_train, order=c(1,1,1), seasonal=c(1,1,1))
sarima2 <- Arima(log_train, order=c(2,1,1), seasonal=c(1,1,1))
sarima3 <- Arima(log_train, order=c(0,1,1), seasonal=c(0,1,1)) # Modèle suggéré
# Création d'un tableau comparatif
models_sarima <- list(auto=auto_sarima, mod1=sarima1, mod2=sarima2, mod3=sarima3)
comparison <- data.frame(
Model = c("SARIMA(0,1,1)(0,1,1)", "SARIMA(1,1,1)(1,1,1)",
"SARIMA(2,1,1)(1,1,1)", "SARIMA(0,1,1)(0,1,1)"),
AIC = sapply(models_sarima, AIC),
BIC = sapply(models_sarima, BIC),
logLik = sapply(models_sarima, logLik),
Sigma2 = sapply(models_sarima, function(x) x$sigma2)
)
print("Comparaison des modèles :")
## [1] "Comparaison des modèles :"
print(comparison)
## Model AIC BIC logLik Sigma2
## auto SARIMA(0,1,1)(0,1,1) -403.6255 -395.6070 204.8128 0.001216853
## mod1 SARIMA(1,1,1)(1,1,1) -400.8575 -387.4934 205.4288 0.001221352
## mod2 SARIMA(2,1,1)(1,1,1) -400.6559 -384.6189 206.3279 0.001210336
## mod3 SARIMA(0,1,1)(0,1,1) -403.6255 -395.6070 204.8128 0.001216853
# Affichage détaillé du meilleur modèle (sarima3)
print("Paramètres estimés du modèle SARIMA(0,1,1)(0,1,1)12 :")
## [1] "Paramètres estimés du modèle SARIMA(0,1,1)(0,1,1)12 :"
print(coef(sarima3))
## ma1 sma1
## -0.6160807 -0.6587092
Les paramètres estimés montrent :
# Analyse complète des résidus
checkresiduals(sarima3)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,1,1)(0,1,1)[12]
## Q* = 32.356, df = 22, p-value = 0.07153
##
## Model df: 2. Total lags used: 24
# Tests statistiques
print("Test de normalité des résidus (Jarque-Bera) :")
## [1] "Test de normalité des résidus (Jarque-Bera) :"
print(jarque.bera.test(residuals(sarima3)))
##
## Jarque Bera Test
##
## data: residuals(sarima3)
## X-squared = 36.692, df = 2, p-value = 1.077e-08
print("Test d'autocorrélation (Ljung-Box) :")
## [1] "Test d'autocorrélation (Ljung-Box) :"
print(Box.test(residuals(sarima3), type="Ljung-Box", lag=24))
##
## Box-Ljung test
##
## data: residuals(sarima3)
## X-squared = 32.356, df = 24, p-value = 0.1184
Le diagnostic des résidus révèle :
# Génération des prévisions
forecast_sarima <- forecast(sarima3, h=12)
# Visualisation des prévisions
plot(forecast_sarima,
main="Prévisions SARIMA(0,1,1)(0,1,1)12",
ylab="Log(Ventes)",
xlab="Année")
lines(log(test_set), col="red", lwd=2)
legend("topleft",
c("Observations", "Prévisions", "Intervalle de confiance 95%"),
col=c("red", "blue", "gray"),
lty=c(1,1,1), lwd=c(2,1,1))
# Évaluation des performances prédictives
print("Mesures de précision sur l'ensemble test :")
## [1] "Mesures de précision sur l'ensemble test :"
accuracy(exp(forecast_sarima$mean), test_set)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set -37.16308 82.6256 69.38355 -2.320982 4.792416 0.4115464 0.4911888
Les prévisions du modèle SARIMA montrent :
Le modèle \(SARIMA(0,1,1)(0,1,1)_{12}\) s’avère être le plus adapté car :
Cette modélisation servira de base pour la comparaison avec l’approche par lissage exponentiel.
Le lissage exponentiel offre une approche alternative qui peut être particulièrement efficace pour les séries avec tendance et saisonnalité. Nous allons explorer différentes variantes de cette méthode.
Commençons par le modèle le plus basique pour comprendre ses limites avec notre série.
# Ajustement du modèle LES
fitLES <- ets(train_set, model="ANN") # A=erreur additive, N=pas de tendance, N=pas de saisonnalité
summary_les <- summary(fitLES)
# Affichage des résultats
print("Paramètres du lissage exponentiel simple :")
## [1] "Paramètres du lissage exponentiel simple :"
print(summary_les)
## ETS(A,N,N)
##
## Call:
## ets(y = train_set, model = "ANN")
##
## Smoothing parameters:
## alpha = 0.1991
##
## Initial states:
## l = 588.8905
##
## sigma: 149.6833
##
## AIC AICc BIC
## 1780.527 1780.734 1788.890
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 35.14453 148.4307 91.57803 2.102238 8.820895 1.192336 -0.005092099
# Prévisions
predLES <- forecast(fitLES, h=12)
# Visualisation
plot(predLES,
main="Prévisions avec Lissage Exponentiel Simple",
ylab="Ventes",
xlab="Année")
lines(test_set, col="red")
round(fitLES$par["alpha"], 4)
## alpha
## 0.1991
Le lissage exponentiel simple montre ses limites :
Ajoutons une composante de tendance pour améliorer les prévisions.
# Ajustement du modèle de Holt
fitLED <- ets(train_set, model="AAN") # A=erreur additive, A=tendance additive, N=pas de saisonnalité
summary_led <- summary(fitLED)
print("Paramètres du lissage exponentiel double :")
## [1] "Paramètres du lissage exponentiel double :"
print(summary_led)
## ETS(A,A,N)
##
## Call:
## ets(y = train_set, model = "AAN")
##
## Smoothing parameters:
## alpha = 0.0202
## beta = 0.0202
##
## Initial states:
## l = 551.2796
## b = 15.9749
##
## sigma: 140.7503
##
## AIC AICc BIC
## 1767.708 1768.234 1781.645
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 4.599057 138.3846 85.56132 -1.428582 8.496652 1.113999 0.04841278
# Prévisions
predLED <- forecast(fitLED, h=12)
# Visualisation
plot(predLED,
main="Prévisions avec Lissage Exponentiel Double",
ylab="Ventes",
xlab="Année")
lines(test_set, col="red")
Le modèle de Holt améliore les prévisions avec :
Intégrons maintenant la composante saisonnière avec la méthode de Holt-Winters.
# Ajustement du modèle de Holt-Winters multiplicatif
hw_mult <- ets(train_set, model="MAM") # M=erreur multiplicative, A=tendance additive, M=saisonnalité multiplicative
summary_hw <- summary(hw_mult)
print("Paramètres du modèle de Holt-Winters :")
## [1] "Paramètres du modèle de Holt-Winters :"
print(summary_hw)
## ETS(M,A,M)
##
## Call:
## ets(y = train_set, model = "MAM")
##
## Smoothing parameters:
## alpha = 0.4106
## beta = 1e-04
## gamma = 2e-04
##
## Initial states:
## l = 597.0197
## b = 6.5425
## s = 1.3877 1.0092 0.9757 0.9612 1.0112 1.0465
## 1.0078 0.9919 0.9232 0.9303 0.8524 0.9029
##
## sigma: 0.0329
##
## AIC AICc BIC
## 1408.181 1414.181 1455.568
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.2070243 29.08407 22.25466 -0.1438774 2.365974 0.2897533
## ACF1
## Training set -0.05561651
# Prévisions
forecast_hw_mult <- forecast(hw_mult, h=12)
# Visualisation
plot(forecast_hw_mult,
main="Prévisions avec Holt-Winters Multiplicatif",
ylab="Ventes",
xlab="Année")
lines(test_set, col="red")
Le modèle de Holt-Winters multiplicatif présente :
# Analyse des résidus
checkresiduals(hw_mult)
##
## Ljung-Box test
##
## data: Residuals from ETS(M,A,M)
## Q* = 26.5, df = 24, p-value = 0.3283
##
## Model df: 0. Total lags used: 24
# Test de Ljung-Box
lb_test <- Box.test(residuals(hw_mult), type="Ljung-Box")
print("Test de Ljung-Box pour les résidus :")
## [1] "Test de Ljung-Box pour les résidus :"
print(lb_test)
##
## Box-Ljung test
##
## data: residuals(hw_mult)
## X-squared = 0.33416, df = 1, p-value = 0.5632
Le diagnostic révèle :
# Création d'un tableau comparatif des erreurs
models_metrics <- data.frame(
Modèle = c("LES", "Holt", "Holt-Winters"),
RMSE = c(
accuracy(predLES)[,"RMSE"],
accuracy(predLED)[,"RMSE"],
accuracy(forecast_hw_mult)[,"RMSE"]
),
MAE = c(
accuracy(predLES)[,"MAE"],
accuracy(predLED)[,"MAE"],
accuracy(forecast_hw_mult)[,"MAE"]
),
MAPE = c(
accuracy(predLES)[,"MAPE"],
accuracy(predLED)[,"MAPE"],
accuracy(forecast_hw_mult)[,"MAPE"]
)
)
print("Comparaison des métriques de performance :")
## [1] "Comparaison des métriques de performance :"
print(models_metrics)
## Modèle RMSE MAE MAPE
## 1 LES 148.43066 91.57803 8.820895
## 2 Holt 138.38459 85.56132 8.496652
## 3 Holt-Winters 29.08407 22.25466 2.365974
Cette comparaison montre une amélioration progressive des performances :
La méthode de Holt-Winters multiplicative s’avère la plus adaptée parmi les approches de lissage exponentiel car :
Pour déterminer la meilleure approche pour nos prévisions, nous allons comparer systématiquement les deux modèles retenus : \(SARIMA(0,1,1)(0,1,1)_{12}\) et Holt-Winters multiplicatif.
# Graphique comparatif des prévisions
par(mfrow=c(1,1))
plot(window(train_set, start=c(1977,1)), # Zoom sur les 3 dernières années
main="Comparaison des prévisions SARIMA et Holt-Winters",
ylab="Ventes (millions $)",
xlab="Année",
xlim=c(1977,1981),
)
# Ajout des observations test
lines(test_set, col="darkgreen", lwd=2)
# Ajout des prévisions SARIMA
lines(exp(forecast_sarima$mean), col="blue", lwd=2)
# Ajout des prévisions Holt-Winters
lines(forecast_hw_mult$mean, col="red", lwd=2)
# Légende
legend("topleft",
c("Observations réelles", "Prévisions SARIMA", "Prévisions Holt-Winters"),
col=c("darkgreen", "blue", "red"),
lty=1, lwd=2)
# Calcul des métriques d'erreur pour SARIMA
pred_sarima <- exp(forecast_sarima$mean)
errors_sarima <- test_set - pred_sarima
metrics_sarima <- c(
RMSE = sqrt(mean(errors_sarima^2)),
MAE = mean(abs(errors_sarima)),
MAPE = mean(abs(errors_sarima/test_set)) * 100
)
# Métriques pour Holt-Winters
errors_hw <- test_set - forecast_hw_mult$mean
metrics_hw <- c(
RMSE = sqrt(mean(errors_hw^2)),
MAE = mean(abs(errors_hw)),
MAPE = mean(abs(errors_hw/test_set)) * 100
)
# Création du tableau comparatif
comparison_final <- rbind(
SARIMA = metrics_sarima,
"Holt-Winters" = metrics_hw
)
print("Comparaison des métriques de performance :")
## [1] "Comparaison des métriques de performance :"
print(round(comparison_final, 2))
## RMSE MAE MAPE
## SARIMA 82.63 69.38 4.79
## Holt-Winters 47.68 39.22 2.78
# Test de Diebold-Mariano pour comparaison statistique
dm_test <- dm.test(errors_sarima, errors_hw, alternative = "two.sided")
print("Test de Diebold-Mariano pour la comparaison des prévisions :")
## [1] "Test de Diebold-Mariano pour la comparaison des prévisions :"
print(dm_test)
##
## Diebold-Mariano Test
##
## data: errors_sarimaerrors_hw
## DM = 2.3738, Forecast horizon = 1, Loss function power = 2, p-value =
## 0.0369
## alternative hypothesis: two.sided
Les deux approches présentent des caractéristiques distinctes :
Sur la base de notre analyse approfondie, nous recommandons :
Quelques points d’attention pour l’utilisation future :
Cette analyse comparative démontre que les deux approches ont leurs mérites, avec une légère supériorité du modèle Holt-Winters pour notre cas d’étude spécifique.