Estimation du taux de change d’équilibre comportemental du Maroc (BEER)
2026-06-10
library(urca)
library(seasonal)
library(psych)
library(tseries)
library(corrplot)
library(lmtest)
library(ggplot2)
library(gridExtra)
library(moments)
library(PerformanceAnalytics)
library(vars)
library(forecast)
library(strucchange)
library(zoo)
library(dplyr)
library(car)
library(uroot)
library(FinTS)
library(stats)
library(Metrics)
library(mFilter)
library(cointReg)
library(scales)0. Importation de la base de données :
df <- readxl::read_excel("C:/Users/PC/Desktop/PFE/Data/Variables/df.xlsx")I. Analyse Exploratoire :
vars_list <- list(
reer = ts(df$reer, start = c(2004, 1), frequency = 12),
ctot = ts(df$ctot, start = c(2004, 1), frequency = 12),
tnt = ts(df$tnt, start = c(2004, 1), frequency = 12),
mre = ts(df$mre, start = c(2004,1), frequency = 12),
reser = ts(df$reser, start = c(2004,1), frequency = 12)
)
var_names <- names(vars_list)1. Étude de la Saisonnalité et des Racines Unitaires Saisonnières :
Avant de procéder à la modélisation, il est impératif d’analyser la nature de la saisonnalité de nos variables. L’objectif est de déterminer si la composante saisonnière est déterministe (des motifs stables qui se répètent) ou stochastique (présence de racines unitaires saisonnières nécessitant l’application d’un filtre de différence saisonnière). Pour ce faire, nous appliquons le test de Canova-Hansen.
1.1. Test de Canova-Hansen (Stabilité Saisonnière) :
Le test de Canova-Hansen (CH) permet de vérifier la stabilité de la saisonnalité. Il s’assure que les cycles saisonniers ne varient pas dans le temps (saisonnalité déterministe).
Hypothèses :
\(H_0\) : La saisonnalité est déterministe (Absence de racine unitaire saisonnière).
\(H_1\) : La saisonnalité est stochastique (Présence d’au moins une racine unitaire saisonnière).
Statistique de test : La statistique \(CH\) repose sur une approche de type multiplicateur de Lagrange. Elle est calculée à partir des sommes cumulées des résidus d’une régression de la série sur des variables trigonométriques (ou muettes) saisonnières :
\[CH = \frac{1}{T^2} \sum_{t=1}^{T} S_t^2\]
où \(T\) est la taille de l’échantillon et \(S_t\) représente la somme cumulée des résidus estimés. Cette statistique ne suit pas une loi standard asymptotique, mais une distribution de type Von Mises dont les valeurs critiques sont tabulées ou interpolées (comme l’indique la sortie R : interpolation in original tables).
Interprétation : Pour l’ensemble des cinq variables analysées, les p-values associées sont très largement supérieures au seuil de signification usuel de 5%.
Nous ne pouvons pas rejeter l’hypothèse nulle \(H_0\). La saisonnalité de toutes nos séries est stable et déterministe. Il n’est pas nécessaire d’appliquer une différenciation saisonnière.
for (v in var_names) {
serie <- vars_list[[v]]
# Test de Canova-Hansen
ch <- ch.test(serie, type = "trigonometric", sid = 1:6)
print(ch)
}## Warning in ch.test(serie, type = "trigonometric", sid = 1:6): argument 'pvalue'
## was changed to 'raw'##
## Canova and Hansen test for seasonal stability
##
## data: serie
##
## statistic pvalue
## statistic 0.3761 0.3585
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Test type: seasonal cycles
## NW covariance matrix lag order: 15
## First order lag: no
## Other regressors: no
## P-values: interpolation in original tables## Warning in ch.test(serie, type = "trigonometric", sid = 1:6): argument 'pvalue'
## was changed to 'raw'##
## Canova and Hansen test for seasonal stability
##
## data: serie
##
## statistic pvalue
## statistic 0.131 0.7765
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Test type: seasonal cycles
## NW covariance matrix lag order: 15
## First order lag: no
## Other regressors: no
## P-values: interpolation in original tables## Warning in ch.test(serie, type = "trigonometric", sid = 1:6): argument 'pvalue'
## was changed to 'raw'##
## Canova and Hansen test for seasonal stability
##
## data: serie
##
## statistic pvalue
## statistic 0.2391 0.5922
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Test type: seasonal cycles
## NW covariance matrix lag order: 15
## First order lag: no
## Other regressors: no
## P-values: interpolation in original tables## Warning in ch.test(serie, type = "trigonometric", sid = 1:6): argument 'pvalue'
## was changed to 'raw'##
## Canova and Hansen test for seasonal stability
##
## data: serie
##
## statistic pvalue
## statistic 0.1913 0.6737
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Test type: seasonal cycles
## NW covariance matrix lag order: 15
## First order lag: no
## Other regressors: no
## P-values: interpolation in original tables## Warning in ch.test(serie, type = "trigonometric", sid = 1:6): argument 'pvalue'
## was changed to 'raw'##
## Canova and Hansen test for seasonal stability
##
## data: serie
##
## statistic pvalue
## statistic 0.1167 0.801
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Test type: seasonal cycles
## NW covariance matrix lag order: 15
## First order lag: no
## Other regressors: no
## P-values: interpolation in original tables2. Statistiques Descriptives, Normalité et Stabilité Structurelle :
Avant d’entamer la modélisation, il est essentiel de caractériser la distribution de nos variables, d’identifier d’éventuels comportements extrêmes et de s’assurer de la stabilité temporelle de ces fondamentaux macroéconomiques.
2.1. Statistiques Descriptives et Test de Jarque-Bera (Normalité) :
L’analyse des moments statistiques (moyenne, écart-type, asymétrie/skewness, aplatissement/kurtosis) permet d’appréhender la forme de la distribution des séries. Le test de Jarque-Bera vient ensuite confirmer statistiquement si ces distributions suivent une loi normale, une hypothèse souvent requise (ou du moins informative) pour certaines inférences asymptotiques.
Hypothèses :
\(H_0\) : La série suit une distribution normale (Asymétrie = 0 et Excès d’aplatissement = 0).
\(H_1\) : La série ne suit pas une distribution normale.
Statistique de test :Le test repose sur les coefficients de Skewness (\(S\)) et de Kurtosis (\(K\)) empiriques :
\[ JB = \frac{n}{6} \left( S^2 + \frac{(K - 3)^2}{4} \right) \]
où \(n\) est la taille de l’échantillon. Sous l’hypothèse nulle, la statistique \(JB\) suit asymptotiquement une loi du Chi-deux à deux degrés de liberté, \(\chi^2(2)\).
Interprétation : Séries normales (reer, ctot, reser) : Les statistiques JB sont faibles avec des p-values supérieures à 0.05. On ne rejette pas H0 . Ces variables présentent une distribution symétrique et un aplatissement conformes à la loi normale (leurs coefficients de Skewness sont proches de 0).
Séries non normales (tnt, mre) : Les p-values sont strictement inférieures à 0.05 (voire de l’ordre de 0 pour mre). On rejette H0 .
L’analyse du tableau descriptif explique ce rejet : mre affiche une asymétrie positive marquée (Skewness = 1.07, décalage vers la droite), tnt une asymétrie positive plus modérée (0.47), tandis que la plupart des séries présentent un kurtosis négatif (distributions platykurtiques, c’est-à-dire plus “aplaties” que la normale, avec des queues moins épaisses).
2.2. Détection des Valeurs Atypiques (Outliers) :
Les variables reer, tnt et reser ne présentent aucun outlier, et ctot n’en compte qu’un seul. Leur comportement est donc très homogène. Seule mre présente quelques valeurs atypiques (7 observations, soit environ 2,7% de l’échantillon), toutes situées au-dessus du seuil supérieur. Il ne s’agit pas d’erreurs de mesure, mais de pics de transferts liés à des épisodes conjoncturels (notamment la forte progression post-COVID), une caractéristique qu’il conviendra de surveiller lors de la modélisation.
desc_df <- data.frame(
Variable = var_names,
N = sapply(vars_list, length),
Moyenne = sapply(vars_list, mean, na.rm = TRUE),
Mediane = sapply(vars_list, median, na.rm = TRUE),
Ecart_type = sapply(vars_list, sd, na.rm = TRUE),
Min = sapply(vars_list, min, na.rm = TRUE),
Max = sapply(vars_list, max, na.rm = TRUE),
Skewness = sapply(vars_list, skewness, na.rm = TRUE),
Kurtosis = sapply(vars_list, kurtosis, na.rm = TRUE)
)
desc_df[, 3:9] <- round(desc_df[, 3:9], 4)
print(desc_df)## Variable N Moyenne Mediane Ecart_type Min Max Skewness
## reer reer 264 100.9209 100.9098 2.7119 94.1206 106.7783 0.0426
## ctot ctot 264 1.0328 1.0327 0.0314 0.9734 1.1330 0.2986
## tnt tnt 264 0.9979 0.9865 0.0689 0.8836 1.1751 0.4712
## mre mre 264 52.5116 46.8675 15.1774 28.9429 103.9461 1.0719
## reser reser 264 213.2092 215.3490 35.2212 141.8541 305.4108 0.0858
## Kurtosis
## reer -0.5050
## ctot -0.3713
## tnt -0.6549
## mre 0.6052
## reser -0.4901for (v in var_names) {
jb <- jarque.bera.test(as.numeric(vars_list[[v]]))
cat(v, ": stat =", round(jb$statistic, 4),
"| p-value =", round(jb$p.value, 4))
if (jb$p.value < 0.05) {
cat(" -> Non normale\n")
} else {
cat(" -> Normale\n")
}
}## reer : stat = 2.8845 | p-value = 0.2364 -> Normale
## ctot : stat = 5.4392 | p-value = 0.0659 -> Normale
## tnt : stat = 14.488 | p-value = 7e-04 -> Non normale
## mre : stat = 54.5817 | p-value = 0 -> Non normale
## reser : stat = 2.9667 | p-value = 0.2269 -> Normalefor (v in var_names) {
serie <- vars_list[[v]]
x_vals <- as.numeric(time(serie))
par(mfrow = c(1, 3))
# Evolution temporelle
plot(serie, main = paste("Serie temporelle -", v),
xlab = "Temps", ylab = v, col = "steelblue", lwd = 1.5)
# Histogramme avec courbe de densite
hist(as.numeric(serie), breaks = 20, probability = TRUE,
main = paste("Distribution -", v), xlab = v,
col = "lightblue", border = "white")
lines(density(as.numeric(serie)), col = "darkblue", lwd = 2)
# Boxplot
boxplot(as.numeric(serie), main = paste("Boxplot -", v),
col = "lightsteelblue", ylab = v)
par(mfrow = c(1, 1))
}
for (v in var_names) {
serie_num <- as.numeric(vars_list[[v]])
Q1 <- quantile(serie_num, 0.25, na.rm = TRUE)
Q3 <- quantile(serie_num, 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
lower <- Q1 - 1.5 * IQR_val
upper <- Q3 + 1.5 * IQR_val
n_outliers <- sum(serie_num < lower | serie_num > upper, na.rm = TRUE)
cat(v, ": nombre d'outliers =", n_outliers,
"| seuil bas =", round(lower, 4),
"| seuil haut =", round(upper, 4), "\n")
}## reer : nombre d'outliers = 0 | seuil bas = 93.587 | seuil haut = 107.7399
## ctot : nombre d'outliers = 1 | seuil bas = 0.9367 | seuil haut = 1.1228
## tnt : nombre d'outliers = 0 | seuil bas = 0.7856 | seuil haut = 1.2132
## mre : nombre d'outliers = 7 | seuil bas = 13.4913 | seuil haut = 91.0885
## reser : nombre d'outliers = 0 | seuil bas = 110.3701 | seuil haut = 315.57931.4 Désaisonnalisation :
reer_ts <- ts(na.omit(df$reer), start = c(2004, 1), frequency = 12)
reer_log <- log(reer_ts)
reer_sa <- seas(reer_log)
reer_clean <- final(reer_sa)
ctot_ts <- ts(na.omit(df$ctot), start = c(2004, 1), frequency = 12)
ctot_log <- log(ctot_ts)
ctot_sa <- seas(ctot_log)## Model used in SEATS is different: (0 1 1)ctot_clean <- final(ctot_sa)
tnt_ts <- ts(na.omit(df$tnt), start = c(2004, 1), frequency = 12)
tnt_log <- log(tnt_ts)
tnt_sa <- seas(tnt_log)## Model used in SEATS is different: (0 1 1)(1 0 0)tnt_clean <- final(tnt_sa)
mre_ts <- ts(na.omit(df$mre), start = c(2004, 1), frequency = 12)
mre_log <- log(mre_ts)
mre_sa <- seas(mre_log)
mre_clean <- final(mre_sa)
reser_ts <- ts(na.omit(df$reser), start = c(2004, 1), frequency = 12)
reser_log <- log(reser_ts)
reser_sa <- seas(reser_log)
reser_clean <- final(reser_sa)
vars_list <- list(
reer = reer_clean,
ctot = ctot_clean,
tnt = tnt_clean,
mre = mre_clean,
reser = reser_clean
)
var_names <- names(vars_list)3. Analyse du Signal, Autocorrélation et Bruit Blanc :
Après avoir étudié la saisonnalité et la stationnarité, il est essentiel de vérifier si nos séries contiennent une réelle structure temporelle (un “signal”) exploitable pour la modélisation, ou s’il s’agit de simples fluctuations aléatoires (un “bruit blanc”). Nous complétons cette approche par une décomposition de la variance et une analyse visuelle des corrélogrammes.
3.1. Test de Ljung-Box (Détection de Bruit Blanc) :
Le test de Ljung-Box permet de vérifier globalement l’absence d’autocorrélation dans une série temporelle jusqu’à un certain retard (ici, \(h = 12\)). Il sert à confirmer que la dynamique de la série n’est pas purement aléatoire.
Hypothèses :
\(H_0\) : La série est un bruit blanc. Les autocorrélations jusqu’à l’ordre \(h\) sont conjointement nulles (\(\rho_1 = \rho_2 = \dots = \rho_h = 0\)).
\(H_1\) : La série n’est pas un bruit blanc. Au moins une autocorrélation est significativement différente de zéro.
Statistique de test : La statistique \(Q\) de Ljung-Box est calculée à partir des autocorrélations empiriques \(\hat{\rho}_k\) : \[ Q = n(n+2) \sum_{k=1}^{h} \frac{\hat{\rho}_k^2}{n-k} \] où \(n\) est la taille de l’échantillon et \(h\) le nombre de retards testés. Sous l’hypothèse nulle, cette statistique suit asymptotiquement une loi du Chi-deux à \(h\) degrés de liberté, soit \(\chi^2(h)\).
Interprétation :Pour nos cinq variables, les statistiques \(Q\) obtenues sont extrêmement élevées avec des p-values strictement égales à 0.
Nous rejetons catégoriquement l’hypothèse nulle \(H_0\) pour l’ensemble des séries. Elles présentent toutes une autocorrélation très significative. Il y a donc un “signal” fort et une mémoire temporelle évidente.
3.2. Ratio Signal/Bruit via Décomposition STL :
Pour aller plus loin que le simple test statistique, nous quantifions la force de ce signal. La méthode STL (Seasonal and Trend decomposition using Loess) décompose la série en trois composantes : Tendance (\(T_t\)), Saisonnalité (\(S_t\)) et Reste/Irrégulier (\(R_t\)). Le ratio Signal/Bruit se concentre sur la variance expliquée par la tendance par rapport à celle du bruit résiduel.
Formules :Le ratio Signal/Bruit (SNR) et la part de la variance due au bruit s’expriment ainsi :
\[ SNR = \frac{Var(Tendance)}{Var(Irr\acute{e}gulier)} \] \[ Part\_Bruit (\%) = \left( \frac{Var(Irr\acute{e}gulier)}{Var(S\acute{e}rie\_Totale)} \right) \times 100 \]
Interprétation :Les résultats de la décomposition confirment l’écrasante domination du signal sur nos variables : Les ratios Signal/Bruit sont tous largement supérieurs à 1. La part de la variance imputable au bruit (la composante irrégulière) est marginale. Les séries étudiées sont très peu bruitées. Leurs dynamiques sont dictées par des tendances de fond solides et peu perturbées par des chocs aléatoires à court terme.
for (v in var_names) {
serie <- vars_list[[v]]
# (a) Test de Ljung-Box
lb_test <- Box.test(serie, lag = 12, type = "Ljung-Box")
cat(" Statistique =", round(lb_test$statistic, 4),
"| p-value =", round(lb_test$p.value, 4), "\n")
if (lb_test$p.value > 0.05) {
cat(" Interpretation : On ne rejette pas H0 -> possible bruit blanc\n")
} else {
cat(" Interpretation : Rejet de H0 -> autocorrelation significative (signal present)\n")
}
# (b) Ratio signal/bruit via decomposition STL
stl_decomp <- stl(serie, s.window = "periodic", robust = TRUE)
var_trend <- var(stl_decomp$time.series[, "trend"], na.rm = TRUE)
var_irregular <- var(stl_decomp$time.series[, "remainder"], na.rm = TRUE)
snr <- var_trend / var_irregular
cat(" Ratio Signal/Bruit (variance tendance / variance irrégulière) =",
round(snr, 4), "\n")
if (snr < 1) {
cat(" Interpretation : Ratio < 1 -> série potentiellement très bruitée\n")
} else {
cat(" Interpretation : Ratio >= 1 -> signal dominant\n")
}
# (c) Proportion de la variance expliquée par l'irrégulier
var_total <- var(serie, na.rm = TRUE)
pct_irregular <- (var_irregular / var_total) * 100
cat(" Part de la variance due au bruit :", round(pct_irregular, 2), "%\n\n")
}## Statistique = 2089.712 | p-value = 0
## Interpretation : Rejet de H0 -> autocorrelation significative (signal present)
## Ratio Signal/Bruit (variance tendance / variance irrégulière) = 18.9568
## Interpretation : Ratio >= 1 -> signal dominant
## Part de la variance due au bruit : 4.68 %
##
## Statistique = 1935.226 | p-value = 0
## Interpretation : Rejet de H0 -> autocorrelation significative (signal present)
## Ratio Signal/Bruit (variance tendance / variance irrégulière) = 8.4843
## Interpretation : Ratio >= 1 -> signal dominant
## Part de la variance due au bruit : 8.95 %
##
## Statistique = 2059.246 | p-value = 0
## Interpretation : Rejet de H0 -> autocorrelation significative (signal present)
## Ratio Signal/Bruit (variance tendance / variance irrégulière) = 14.2759
## Interpretation : Ratio >= 1 -> signal dominant
## Part de la variance due au bruit : 6.15 %
##
## Statistique = 2423.627 | p-value = 0
## Interpretation : Rejet de H0 -> autocorrelation significative (signal present)
## Ratio Signal/Bruit (variance tendance / variance irrégulière) = 41.2848
## Interpretation : Ratio >= 1 -> signal dominant
## Part de la variance due au bruit : 2.33 %
##
## Statistique = 1904.929 | p-value = 0
## Interpretation : Rejet de H0 -> autocorrelation significative (signal present)
## Ratio Signal/Bruit (variance tendance / variance irrégulière) = 22.0812
## Interpretation : Ratio >= 1 -> signal dominant
## Part de la variance due au bruit : 4.15 %4. Analyse des Corrélations et de la Multicolinéarité :
Avant d’estimer le modèle, il est primordial de vérifier l’existence de relations bi-variées significatives entre le taux de change effectif réel (REER) et ses fondamentaux théoriques, tout en s’assurant que ces variables explicatives ne sont pas redondantes entre elles (multicolinéarité).
4.1. Corrélations Linéaires (Pearson) et Monotones (Spearman) :
On cherche à évaluer l’intensité et la direction de la relation entre nos paires de variables. Le coefficient de Pearson mesure la dépendance strictement linéaire, tandis que le coefficient de Spearman (basé sur les rangs) évalue la relation monotone, ce qui offre une garantie de robustesse face aux variables qui ne suivent pas une loi normale (comme nous l’avons identifié précédemment).
Hypothèses :
\(H_0\) : Le coefficient de corrélation est nul (\(r = 0\) ou \(\rho = 0\)). Les variables sont linéairement (ou de façon monotone) indépendantes.
\(H_1\) : Le coefficient de corrélation est significativement différent de zéro.
Formules : Le coefficient de Pearson (\(r\)) et celui de Spearman (\(\rho\)) se calculent ainsi :
\[ r_{xy} = \frac{\sum_{i=1}^{n} (x_i - \bar{x})(y_i - \bar{y})}{\sqrt{\sum_{i=1}^{n} (x_i - \bar{x})^2 \sum_{i=1}^{n} (y_i - \bar{y})^2}} \] \[ \rho = 1 - \frac{6 \sum d_i^2}{n(n^2 - 1)} \] (où \(d_i\) est la différence entre les rangs des observations \(x_i\) et \(y_i\)). La statistique de test pour la p-value suit une loi de Student à \(n-2\) degrés de liberté :
\[ t = r \sqrt{\frac{n-2}{1-r^2}} \] Interprétation : Relation avec le REER : Toutes les variables fondamentales présentent une corrélation statistiquement très significative (p-values \(< 0.05\), souvent approchant \(0\)) avec le REER.
4.3. Détection de la Multicolinéarité (Facteur d’Inflation de la Variance - VIF) :
Formule : Le VIF d’une variable explicative \(j\) est calculé à partir du \(R^2\) de la régression auxiliaire de cette variable sur toutes les autres variables explicatives : \[ VIF_j = \frac{1}{1 - R_j^2} \] En règle générale, un \(VIF > 5\) indique un problème sévère de multicolinéarité, et un \(VIF > 10\) est jugé critique.
n_min <- min(sapply(vars_list, length))
mat <- sapply(vars_list, function(x) as.numeric(x)[seq_len(n_min)])
df_clean <- as.data.frame(mat)
colnames(df_clean) <- var_names
cor_mat <- cor(df_clean, use = "complete.obs", method = "pearson")
print(round(cor_mat, 4))## reer ctot tnt mre reser
## reer 1.0000 0.3499 0.5160 -0.1542 0.3447
## ctot 0.3499 1.0000 0.1101 0.0359 0.2124
## tnt 0.5160 0.1101 1.0000 0.4233 0.3722
## mre -0.1542 0.0359 0.4233 1.0000 0.6337
## reser 0.3447 0.2124 0.3722 0.6337 1.0000corrplot(cor_mat,
method = "color",
type = "upper",
tl.cex = 0.8,
addCoef.col = "black",
number.cex = 0.7,
col = colorRampPalette(c("#d73027", "white", "#1a9850"))(200),
title = "Matrice de correlation (Pearson)",
mar = c(0, 0, 2, 0))
for (i in 1:(length(var_names) - 1)) {
for (j in (i + 1):length(var_names)) {
v1 <- var_names[i]
v2 <- var_names[j]
ct <- cor.test(df_clean[[v1]], df_clean[[v2]], method = "pearson")
sig <- ifelse(ct$p.value < 0.05, "***", "ns")
cat(sprintf("%-10s vs %-10s : r = %6.4f | p = %6.4f %s\n",
v1, v2, ct$estimate, ct$p.value, sig))
}
}## reer vs ctot : r = 0.3499 | p = 0.0000 ***
## reer vs tnt : r = 0.5160 | p = 0.0000 ***
## reer vs mre : r = -0.1542 | p = 0.0121 ***
## reer vs reser : r = 0.3447 | p = 0.0000 ***
## ctot vs tnt : r = 0.1101 | p = 0.0741 ns
## ctot vs mre : r = 0.0359 | p = 0.5617 ns
## ctot vs reser : r = 0.2124 | p = 0.0005 ***
## tnt vs mre : r = 0.4233 | p = 0.0000 ***
## tnt vs reser : r = 0.3722 | p = 0.0000 ***
## mre vs reser : r = 0.6337 | p = 0.0000 ***fondamentaux <- setdiff(var_names, "reer")
par(mfrow = c(2, 4))
for (v in fondamentaux) {
plot(df_clean[[v]], df_clean$reer,
main = paste("REER vs", v),
xlab = v, ylab = "REER",
col = "steelblue", pch = 16, cex = 0.7)
abline(lm(df_clean$reer ~ df_clean[[v]]), col = "red", lwd = 2)
}
par(mfrow = c(1, 1))
cor_spear <- cor(df_clean, use = "complete.obs", method = "spearman")
print(round(cor_spear, 4))## reer ctot tnt mre reser
## reer 1.0000 0.2933 0.5318 -0.2750 0.3074
## ctot 0.2933 1.0000 0.1709 0.1517 0.1477
## tnt 0.5318 0.1709 1.0000 0.2085 0.3939
## mre -0.2750 0.1517 0.2085 1.0000 0.5797
## reser 0.3074 0.1477 0.3939 0.5797 1.0000par(mfrow = c(2, 4))
for (v in fondamentaux) {
ccf(df_clean$reer, df_clean[[v]],
lag.max = 12,
main = paste("CCF REER /", v),
ylab = "Correlation", col = "steelblue")
}
par(mfrow = c(1, 1))
## VIF
reg_aux <- lm(reer_clean ~ ctot_clean + tnt_clean + mre_clean
+ reser_clean)
vif_vals <- vif(reg_aux)
print(round(vif_vals, 4))## ctot_clean tnt_clean mre_clean reser_clean
## 1.0709 1.2521 1.8316 1.80745. Tests de Stationnarité et de Racine Unitaire :
Avant d’envisager une relation de cointégration (de long terme) pour estimer le taux de change d’équilibre, nous devons nous assurer qu’aucune de nos séries n’est intégrée d’ordre 2 (\(I(2)\)). Pour garantir la robustesse de notre diagnostic, nous déployons une batterie de tests classiques (ADF, PP, KPSS).
5.1. Tests Classiques en Niveau (ADF, PP et KPSS)
Les tests de Dickey-Fuller Augmenté (ADF) et de Phillips-Perron (PP) cherchent à détecter la présence d’une racine unitaire. Le test KPSS (Kwiatkowski-Phillips-Schmidt-Shin) est utilisé de manière confirmatoire car il inverse les hypothèses.
Hypothèses :Tests ADF et PP :
\(H_0\) : La série possède une racine unitaire (elle est non stationnaire).
\(H_1\) : La série est stationnaire (autour d’une tendance déterministe pour nos tests en niveau).
L’équation de base du test ADF avec constante et tendance s’écrit : \[ \Delta Y_t = \alpha + \beta t + \gamma Y_{t-1} + \sum_{i=1}^{p} \delta_i \Delta Y_{t-i} + \varepsilon_t \] Le test porte sur la significativité du paramètre \(\gamma\) (statistique \(\tau_3\)). Le test PP corrige non-paramétriquement l’autocorrélation des résidus sans ajouter de retards \(\Delta Y_{t-i}\).
Test KPSS : \(H_0\) : La série est stationnaire.
\(H_1\) : La série possède une racine unitaire.
Résultats sur les variables en niveau : Les résultats sont unanimes et convergents sur l’ensemble des cinq variables (reer, ctot, tnt, mre, reser) :
L’approche confirmatoire est parfaite. Toutes nos séries en niveau sont non stationnaires.
5.3. Tests ADF en Différences Premières (Ordre d’intégration) :
Sur l’ensemble des séries différenciées (d_reer, d_ctot, d_tnt, d_mre, d_reser), les statistiques du test ADF s’effondrent et deviennent très négatives.Toutes ces statistiques dépassent très largement la valeur critique tabulée à 5% (qui est de -2.87).
Nos fondamentaux sont strictement intégrés d’ordre 1, soit \(I(1)\).
#ADF
summary(ur.df(reer_clean, type = "trend", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.028800 -0.002218 -0.000051 0.002245 0.044864
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.086e-01 7.143e-02 2.921 0.003826 **
## z.lag.1 -4.525e-02 1.547e-02 -2.924 0.003781 **
## tt -5.560e-07 4.965e-06 -0.112 0.910929
## z.diff.lag1 -3.492e-01 6.307e-02 -5.537 8.07e-08 ***
## z.diff.lag2 1.183e-01 6.619e-02 1.787 0.075209 .
## z.diff.lag3 2.512e-01 6.685e-02 3.758 0.000215 ***
## z.diff.lag4 3.402e-02 6.867e-02 0.495 0.620741
## z.diff.lag5 -3.168e-02 6.870e-02 -0.461 0.645177
## z.diff.lag6 7.026e-02 6.731e-02 1.044 0.297556
## z.diff.lag7 2.036e-01 6.727e-02 3.027 0.002737 **
## z.diff.lag8 1.554e-01 6.360e-02 2.444 0.015249 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005575 on 240 degrees of freedom
## Multiple R-squared: 0.2233, Adjusted R-squared: 0.191
## F-statistic: 6.902 on 10 and 240 DF, p-value: 1.767e-09
##
##
## Value of test-statistic is: -2.9244 2.9208 4.2875
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -3.98 -3.42 -3.13
## phi2 6.15 4.71 4.05
## phi3 8.34 6.30 5.36summary(ur.df(ctot_clean, type = "trend", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0185731 -0.0032957 -0.0003572 0.0029096 0.0251546
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.750e-05 7.757e-04 0.074 0.94097
## z.lag.1 -3.296e-02 1.256e-02 -2.623 0.00925 **
## tt 7.561e-06 5.339e-06 1.416 0.15797
## z.diff.lag 3.901e-01 5.849e-02 6.670 1.66e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005652 on 247 degrees of freedom
## Multiple R-squared: 0.1653, Adjusted R-squared: 0.1551
## F-statistic: 16.3 on 3 and 247 DF, p-value: 1.064e-09
##
##
## Value of test-statistic is: -2.6234 2.3701 3.538
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -3.98 -3.42 -3.13
## phi2 6.15 4.71 4.05
## phi3 8.34 6.30 5.36summary(ur.df(tnt_clean, type = "trend", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.045696 -0.007042 -0.000360 0.005892 0.105665
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.038e-03 2.092e-03 -1.930 0.05471 .
## z.lag.1 -3.980e-02 1.446e-02 -2.752 0.00636 **
## tt 2.513e-05 1.332e-05 1.886 0.06042 .
## z.diff.lag 1.283e-01 6.215e-02 2.065 0.04000 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.01433 on 247 degrees of freedom
## Multiple R-squared: 0.04698, Adjusted R-squared: 0.0354
## F-statistic: 4.058 on 3 and 247 DF, p-value: 0.007704
##
##
## Value of test-statistic is: -2.7522 2.8777 4.2861
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -3.98 -3.42 -3.13
## phi2 6.15 4.71 4.05
## phi3 8.34 6.30 5.36summary(ur.df(mre_clean, type = "trend", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.091786 -0.023240 -0.002803 0.017526 0.188880
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.487e-01 8.413e-02 1.767 0.07846 .
## z.lag.1 -4.091e-02 2.351e-02 -1.740 0.08311 .
## tt 1.177e-04 6.815e-05 1.726 0.08560 .
## z.diff.lag1 -4.161e-01 6.341e-02 -6.563 3.31e-10 ***
## z.diff.lag2 -6.466e-02 6.882e-02 -0.939 0.34843
## z.diff.lag3 4.374e-02 6.896e-02 0.634 0.52655
## z.diff.lag4 6.646e-02 6.881e-02 0.966 0.33513
## z.diff.lag5 2.102e-01 6.878e-02 3.057 0.00249 **
## z.diff.lag6 1.468e-01 7.006e-02 2.095 0.03722 *
## z.diff.lag7 4.927e-03 7.039e-02 0.070 0.94426
## z.diff.lag8 -6.404e-03 6.941e-02 -0.092 0.92657
## z.diff.lag9 -1.455e-02 6.943e-02 -0.210 0.83421
## z.diff.lag10 3.280e-02 6.962e-02 0.471 0.63799
## z.diff.lag11 3.387e-02 6.930e-02 0.489 0.62542
## z.diff.lag12 -2.629e-01 6.254e-02 -4.205 3.71e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03846 on 236 degrees of freedom
## Multiple R-squared: 0.3301, Adjusted R-squared: 0.2903
## F-statistic: 8.305 on 14 and 236 DF, p-value: 1.903e-14
##
##
## Value of test-statistic is: -1.7403 2.0978 1.6064
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -3.98 -3.42 -3.13
## phi2 6.15 4.71 4.05
## phi3 8.34 6.30 5.36summary(ur.df(reser_clean, type = "trend", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.095784 -0.019536 0.000737 0.016116 0.103947
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.210e-01 7.011e-02 1.726 0.0856 .
## z.lag.1 -2.333e-02 1.340e-02 -1.741 0.0830 .
## tt 4.007e-05 2.980e-05 1.344 0.1801
## z.diff.lag 1.845e-01 6.277e-02 2.939 0.0036 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03068 on 247 degrees of freedom
## Multiple R-squared: 0.04309, Adjusted R-squared: 0.03146
## F-statistic: 3.707 on 3 and 247 DF, p-value: 0.01228
##
##
## Value of test-statistic is: -1.7407 1.3604 1.7216
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -3.98 -3.42 -3.13
## phi2 6.15 4.71 4.05
## phi3 8.34 6.30 5.36#KPSS
summary(ur.kpss(reer_clean, type = "tau", lags = "short"))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: tau with 5 lags.
##
## Value of test-statistic is: 0.6202
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.119 0.146 0.176 0.216summary(ur.kpss(ctot_clean, type = "tau", lags = "short"))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: tau with 5 lags.
##
## Value of test-statistic is: 0.2779
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.119 0.146 0.176 0.216summary(ur.kpss(tnt_clean, type = "tau", lags = "short"))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: tau with 5 lags.
##
## Value of test-statistic is: 0.7965
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.119 0.146 0.176 0.216summary(ur.kpss(mre_clean, type = "tau", lags = "short"))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: tau with 5 lags.
##
## Value of test-statistic is: 0.5528
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.119 0.146 0.176 0.216summary(ur.kpss(reser_clean, type = "tau", lags = "short"))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: tau with 5 lags.
##
## Value of test-statistic is: 0.3941
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.119 0.146 0.176 0.216#PP
summary(ur.pp(reer_clean, type = "Z-tau", model = "trend", lags = "short"))##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.043821 -0.002442 -0.000042 0.002311 0.048301
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.664e-01 6.883e-02 2.417 0.0163 *
## y.l1 9.639e-01 1.492e-02 64.615 <2e-16 ***
## trend 1.466e-06 4.987e-06 0.294 0.7690
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.006033 on 260 degrees of freedom
## Multiple R-squared: 0.9432, Adjusted R-squared: 0.9428
## F-statistic: 2158 on 2 and 260 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -2.2836
##
## aux. Z statistics
## Z-tau-mu 3.0589
## Z-tau-beta -0.0772
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.996246 -3.428215 -3.137204summary(ur.pp(ctot_clean, type = "Z-tau", model = "trend", lags = "short"))##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0197447 -0.0033812 -0.0007705 0.0026736 0.0291936
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.287e-04 5.545e-04 1.495 0.136
## y.l1 9.760e-01 1.304e-02 74.843 <2e-16 ***
## trend 6.606e-06 5.197e-06 1.271 0.205
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.006007 on 260 degrees of freedom
## Multiple R-squared: 0.9611, Adjusted R-squared: 0.9608
## F-statistic: 3215 on 2 and 260 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -2.4389
##
## aux. Z statistics
## Z-tau-mu 0.2718
## Z-tau-beta 1.3207
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.996246 -3.428215 -3.137204summary(ur.pp(tnt_clean, type = "Z-tau", model = "trend", lags = "short"))##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.044909 -0.007071 -0.000056 0.005747 0.100993
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.962e-04 8.845e-04 -0.448 0.655
## y.l1 9.697e-01 1.324e-02 73.246 <2e-16 ***
## trend 1.809e-05 1.189e-05 1.521 0.129
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.01431 on 260 degrees of freedom
## Multiple R-squared: 0.9561, Adjusted R-squared: 0.9558
## F-statistic: 2834 on 2 and 260 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -2.4729
##
## aux. Z statistics
## Z-tau-mu -0.3570
## Z-tau-beta 1.4359
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.996246 -3.428215 -3.137204summary(ur.pp(mre_clean, type = "Z-tau", model = "trend", lags = "short"))##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.133888 -0.027790 -0.002276 0.022862 0.229857
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.951e-01 9.331e-02 3.162 0.00175 **
## y.l1 9.256e-01 2.379e-02 38.901 < 2e-16 ***
## trend 2.019e-04 7.195e-05 2.806 0.00540 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04465 on 260 degrees of freedom
## Multiple R-squared: 0.9628, Adjusted R-squared: 0.9625
## F-statistic: 3366 on 2 and 260 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -2.5098
##
## aux. Z statistics
## Z-tau-mu 5.3675
## Z-tau-beta 2.1384
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.996246 -3.428215 -3.137204summary(ur.pp(reser_clean, type = "Z-tau", model = "trend", lags = "short"))##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.106831 -0.018550 0.000998 0.016529 0.104816
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.119e-01 7.050e-02 1.587 0.114
## y.l1 9.795e-01 1.318e-02 74.315 <2e-16 ***
## trend 2.914e-05 2.898e-05 1.005 0.316
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03084 on 260 degrees of freedom
## Multiple R-squared: 0.9665, Adjusted R-squared: 0.9662
## F-statistic: 3746 on 2 and 260 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -2.034
##
## aux. Z statistics
## Z-tau-mu 0.4597
## Z-tau-beta 1.3702
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.996246 -3.428215 -3.137204## Différences premières
d_reer <- diff(reer_clean)
d_ctot <- diff(ctot_clean)
d_tnt <- diff(tnt_clean)
d_mre <- diff(mre_clean)
d_reser <- diff(reser_clean)
## ADF en différences
summary(ur.df(d_reer, type = "drift", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.029599 -0.001972 -0.000031 0.002198 0.046906
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0001973 0.0003621 -0.545 0.586314
## z.lag.1 -0.9754321 0.1290336 -7.560 8e-13 ***
## z.diff.lag1 -0.3562104 0.1033849 -3.445 0.000670 ***
## z.diff.lag2 -0.2299050 0.0622376 -3.694 0.000272 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005713 on 246 degrees of freedom
## Multiple R-squared: 0.6873, Adjusted R-squared: 0.6835
## F-statistic: 180.2 on 3 and 246 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -7.5595 28.5757
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.44 -2.87 -2.57
## phi1 6.47 4.61 3.79summary(ur.df(d_ctot, type = "drift", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0211417 -0.0033843 -0.0005847 0.0031104 0.0243220
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.214e-05 3.625e-04 0.171 0.864
## z.lag.1 -6.168e-01 7.111e-02 -8.673 5.7e-16 ***
## z.diff.lag -1.079e-02 6.371e-02 -0.169 0.866
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005732 on 247 degrees of freedom
## Multiple R-squared: 0.3112, Adjusted R-squared: 0.3057
## F-statistic: 55.81 on 2 and 247 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -8.6733 37.6147
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.44 -2.87 -2.57
## phi1 6.47 4.61 3.79summary(ur.df(d_tnt, type = "drift", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.041833 -0.006967 -0.000045 0.006667 0.093822
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0001696 0.0009090 -0.187 0.85215
## z.lag.1 -0.8894426 0.1420056 -6.263 1.71e-09 ***
## z.diff.lag1 0.0087833 0.1346001 0.065 0.94803
## z.diff.lag2 0.0367051 0.1260024 0.291 0.77107
## z.diff.lag3 0.0216175 0.1146242 0.189 0.85057
## z.diff.lag4 0.0783860 0.1000586 0.783 0.43416
## z.diff.lag5 0.1551351 0.0836684 1.854 0.06493 .
## z.diff.lag6 0.1790325 0.0626965 2.856 0.00467 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.01437 on 242 degrees of freedom
## Multiple R-squared: 0.4631, Adjusted R-squared: 0.4476
## F-statistic: 29.82 on 7 and 242 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -6.2634 19.6181
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.44 -2.87 -2.57
## phi1 6.47 4.61 3.79summary(ur.df(d_mre, type = "drift", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.09479 -0.02354 -0.00207 0.01849 0.19715
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.004567 0.002601 1.756 0.0804 .
## z.lag.1 -1.472917 0.279416 -5.271 3.04e-07 ***
## z.diff.lag1 0.034197 0.270215 0.127 0.8994
## z.diff.lag2 -0.047289 0.258821 -0.183 0.8552
## z.diff.lag3 -0.019929 0.246859 -0.081 0.9357
## z.diff.lag4 0.030802 0.235026 0.131 0.8958
## z.diff.lag5 0.223666 0.223198 1.002 0.3173
## z.diff.lag6 0.351072 0.211608 1.659 0.0984 .
## z.diff.lag7 0.333795 0.196893 1.695 0.0913 .
## z.diff.lag8 0.303388 0.174514 1.738 0.0834 .
## z.diff.lag9 0.263834 0.146591 1.800 0.0732 .
## z.diff.lag10 0.271154 0.110387 2.456 0.0148 *
## z.diff.lag11 0.281540 0.062113 4.533 9.24e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03863 on 237 degrees of freedom
## Multiple R-squared: 0.7624, Adjusted R-squared: 0.7504
## F-statistic: 63.38 on 12 and 237 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -5.2714 13.8953
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.44 -2.87 -2.57
## phi1 6.47 4.61 3.79summary(ur.df(d_reser, type = "drift", lags = 12, selectlags = "AIC"))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression drift
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.100685 -0.019170 0.001891 0.016299 0.107087
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.001361 0.001954 0.697 0.487
## z.lag.1 -0.778469 0.081602 -9.540 <2e-16 ***
## z.diff.lag -0.061295 0.063413 -0.967 0.335
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0308 on 247 degrees of freedom
## Multiple R-squared: 0.4174, Adjusted R-squared: 0.4127
## F-statistic: 88.48 on 2 and 247 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -9.5398 45.5053
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau2 -3.44 -2.87 -2.57
## phi1 6.47 4.61 3.79II. Modélisation : VECM
Y_brut <- data.frame(
reer = vars_list$reer,
ctot = vars_list$ctot,
tnt = vars_list$tnt,
mre = vars_list$mre,
reser = vars_list$reser
)dates_obs <- as.Date(df$Month)
dum_crise <- ifelse(dates_obs >= as.Date("2009-01-01") & dates_obs <= as.Date("2009-12-31"), 1, 0)
dum_oil <- ifelse(dates_obs >= as.Date("2015-12-01"), 1, 0)
dum_float <- ifelse(dates_obs >= as.Date("2018-01-01"), 1, 0)
dum_covid <- ifelse(dates_obs >= as.Date("2020-03-01") & dates_obs <= as.Date("2020-06-01"), 1, 0)
dum_ukraine <- ifelse(dates_obs >= as.Date("2022-02-01"), 1, 0)
exo_brut <- cbind(dum_crise, dum_oil, dum_float, dum_covid, dum_ukraine)
colnames(exo_brut) <- c("dum_crise", "dum_oil", "dum_float", "dum_covid", "dum_ukraine")full_data <- cbind(Y_brut, exo_brut)
full_data_clean <- na.omit(full_data)
Y <- full_data_clean[, c("reer", "ctot", "tnt", "mre", "reser")]
exo_mat <- as.matrix(full_data_clean[, c("dum_crise", "dum_oil", "dum_float", "dum_covid", "dum_ukraine")])lag_select <- VARselect(Y, lag.max = 5, type = "const", exogen = exo_mat)
print(lag_select$selection)## AIC(n) HQ(n) SC(n) FPE(n)
## 2 2 2 2p_opt <- lag_select$selection["AIC(n)"] 1. Analyse de Cointégration (Approche de Johansen) :
Puisque nos variables sont intégrées du même ordre, nous devons vérifier s’il existe une ou plusieurs combinaisons linéaires stationnaires entre elles. Si tel est le cas, cela signifie que ces variables partagent une tendance stochastique commune et ne s’éloignent jamais durablement les unes des autres : c’est la relation d’équilibre de long terme (le taux de change fondamental d’équilibre).Pour ce faire, nous appliquons la procédure de Johansen basée sur un modèle à Vecteur à Correction d’Erreur (VECM).
1.1. Spécification du Modèle et Prise en compte des Chocs :
Le critère d’Akaike (AIC) a sélectionné un décalage optimal de \(p = 2\) pour le VAR en niveau, ce qui correspond à \(K = 2\) dans la procédure de Johansen.
1.2. Tests du Nombre de Vecteurs de Cointégration :
(\(r\))L’approche de Johansen propose deux tests statistiques distincts pour déterminer le rang de cointégration (\(r\)), c’est-à-dire le nombre de relations d’équilibre.
A. Le Test de la Trace
Hypothèses :
\(H_0 : r \le q\) contre
\(H_1 : r > q\).
Statistique : \(\lambda_{trace} = -T \sum_{i=q+1}^{k} \ln(1 - \hat{\lambda}_i)\)
Résultats :
Pour \(r = 0\) : Stat = 96.10 > VC 5% (76.07) \(\rightarrow\) Rejet de \(H_0\). Il y a au moins 1 relation.
Pour \(r \le 1\) : Stat = 58.20 > VC 5% (53.12) \(\rightarrow\) Rejet de \(H_0\). Il y a au moins 2 relations.
Pour \(r \le 2\) : Stat = 36.03 > VC 5% (34.91) \(\rightarrow\) Rejet de \(H_0\). Il y a au moins 3 relations.
Pour \(r \le 3\) : Stat = 16.48 < VC 5% (19.96) \(\rightarrow\) Non rejet de \(H_0\). Selon le test de la Trace, il existerait \(r = 3\) relations de cointégration.
B. Le Test de la Valeur Propre Maximale (Max-Eigen) :
Hypothèses :
\(H_0 : r = q\) contre
\(H_1 : r = q + 1\).
Statistique :
\(\lambda_{max} = -T \ln(1 - \hat{\lambda}_{q+1})\)
Interprétations :
Pour \(r = 0\) : Stat = 37.90 > VC 5% (34.40) \(\rightarrow\) Rejet de \(H_0\). Il y a au moins 1 relation.
Pour \(r \le 1\) : Stat = 22.17 < VC 5% (28.14) \(\rightarrow\) Non rejet de \(H_0\).
Selon le test Max-Eigen, il existe exactement \(r = 1\) relation de cointégration.
Il est très fréquent que ces deux tests divergent sur des échantillons de taille modérée ou en présence de plusieurs variables. Économiquement, notre objectif est d’isoler une unique trajectoire de long terme pour le taux de change effectif réel (REER) en fonction de ses fondamentaux. Par conséquent, nous nous appuyons sur le résultat du test de la valeur propre maximale et retenons \(r = 1\) relation de cointégration.
1.3. La Relation d’Équilibre de Long Terme (BEER) :
En retenant le premier vecteur propre normalisé sur la variable reer.l1 (première colonne du tableau Eigenvectors), la relation de cointégration s’écrit sous la forme \(\beta' Y_{t-1} = 0\) :
\[ REER_{t-1} - 0.5256 ctot_{t-1} - 0.2910 tnt_{t-1} + 0.0617 mre_{t-1} - 0.0567 reser_{t-1} - 4.5454 = 0 \] En isolant le REER pour obtenir l’équation de comportement (le taux de change d’équilibre fondamental), on inverse les signes :
\[ REER_{eq} = 0.5256 ctot + 0.2910 tnt - 0.0617 mre + 0.0567 reser + 4.5454 \] Interprétation Économique des coefficients de Long Terme :
ctot (+0.5256) : Une amélioration des termes de l’échange conduit à une appréciation réelle du dirham à long terme (effet de richesse).
tnt (+0.2910) : Une hausse de la part des biens non-échangeables (effet Balassa-Samuelson / productivité relative) apprécie le taux de change réel d’équilibre.
mre (-0.0617) : Une augmentation des transferts MRE déprécie légèrement le REER. Ce signe contre intuitif est discuté ultérieurement.
reser (+0.0567) : L’accumulation de réserves de change s’accompagne d’une appréciation réelle de long terme.
1.4. Force de Rappel et Stabilité du Modèle (Matrice des Poids \(\alpha\)) :
La présence de cointégration implique l’existence d’un mécanisme de correction d’erreur. Les “Weights W” de la sortie R correspondent à la matrice des coefficients d’ajustement (\(\alpha\)). Pour la première équation (\(\Delta REER_t\)), le coefficient de la force de rappel est :
\[ \alpha_{11} = -0.0662 \] Interprétation :Ce coefficient est, comme l’exige la théorie, négatif et de module inférieur à 1. Cela garantit la stabilité du système : en cas de choc éloignant le REER de son niveau fondamental, les forces macroéconomiques s’activent pour ramener le taux de change vers son équilibre.La vitesse d’ajustement est d’environ 6.6 % par mois. Cela signifie qu’il faut un peu plus d’un an pour corriger l’essentiel d’un déséquilibre conjoncturel, confirmant la pertinence de cette modélisation pour l’analyse des mésalignements du dirham.
johansen_trace <- ca.jo(Y, type = "trace", ecdet = "const", K = p_opt, spec = "transitory", dumvar = exo_mat)
summary(johansen_trace)##
## ######################
## # Johansen-Procedure #
## ######################
##
## Test type: trace statistic , without linear trend and constant in cointegration
##
## Eigenvalues (lambda):
## [1] 1.346927e-01 8.113565e-02 7.188605e-02 4.395934e-02 1.779890e-02
## [6] -1.590050e-17
##
## Values of teststatistic and critical values of test:
##
## test 10pct 5pct 1pct
## r <= 4 | 4.71 7.52 9.24 12.97
## r <= 3 | 16.48 17.85 19.96 24.60
## r <= 2 | 36.03 32.00 34.91 41.07
## r <= 1 | 58.20 49.65 53.12 60.16
## r = 0 | 96.10 71.86 76.07 84.45
##
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1 constant
## reer.l1 1.00000000 1.0000000 1.0000000 1.0000000 1.00000000 1.000000
## ctot.l1 -0.52561189 1.0302092 0.3992124 -0.9842529 2.10680105 28.204979
## tnt.l1 -0.29100303 -0.7044182 0.1403102 -0.7883792 0.13657211 -6.585821
## mre.l1 0.06168909 0.1103258 0.1798662 -1.2734913 -0.07199194 7.629783
## reser.l1 -0.05668070 -0.1155818 -0.1729721 0.3145288 0.85467959 4.385058
## constant -4.54542667 -4.4597914 -4.3748981 -1.3814824 -8.93316098 -55.126174
##
## Weights W:
## (This is the loading matrix)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1
## reer.d -0.06622583 0.041312805 -0.025801962 -0.001182462 -0.001147939
## ctot.d 0.01990337 -0.002222231 -0.008543333 0.002465998 -0.004779618
## tnt.d 0.24487102 0.100149393 -0.013333174 0.001221596 0.001478669
## mre.d -0.19792733 0.023997872 0.071719159 0.059742639 0.014372620
## reser.d -0.21019257 0.108376950 0.273947675 -0.003059153 -0.002590296
## constant
## reer.d 3.228874e-16
## ctot.d -1.518428e-16
## tnt.d -2.582090e-16
## mre.d 1.601285e-15
## reser.d 1.306527e-16johansen_maxeigen <- ca.jo(Y, type = "eigen", ecdet = "const", K = p_opt, spec = "transitory", dumvar = exo_mat)
summary(johansen_maxeigen)##
## ######################
## # Johansen-Procedure #
## ######################
##
## Test type: maximal eigenvalue statistic (lambda max) , without linear trend and constant in cointegration
##
## Eigenvalues (lambda):
## [1] 1.346927e-01 8.113565e-02 7.188605e-02 4.395934e-02 1.779890e-02
## [6] -1.590050e-17
##
## Values of teststatistic and critical values of test:
##
## test 10pct 5pct 1pct
## r <= 4 | 4.71 7.52 9.24 12.97
## r <= 3 | 11.78 13.75 15.67 20.20
## r <= 2 | 19.55 19.77 22.00 26.81
## r <= 1 | 22.17 25.56 28.14 33.24
## r = 0 | 37.90 31.66 34.40 39.79
##
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1 constant
## reer.l1 1.00000000 1.0000000 1.0000000 1.0000000 1.00000000 1.000000
## ctot.l1 -0.52561189 1.0302092 0.3992124 -0.9842529 2.10680105 28.204979
## tnt.l1 -0.29100303 -0.7044182 0.1403102 -0.7883792 0.13657211 -6.585821
## mre.l1 0.06168909 0.1103258 0.1798662 -1.2734913 -0.07199194 7.629783
## reser.l1 -0.05668070 -0.1155818 -0.1729721 0.3145288 0.85467959 4.385058
## constant -4.54542667 -4.4597914 -4.3748981 -1.3814824 -8.93316098 -55.126174
##
## Weights W:
## (This is the loading matrix)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1
## reer.d -0.06622583 0.041312805 -0.025801962 -0.001182462 -0.001147939
## ctot.d 0.01990337 -0.002222231 -0.008543333 0.002465998 -0.004779618
## tnt.d 0.24487102 0.100149393 -0.013333174 0.001221596 0.001478669
## mre.d -0.19792733 0.023997872 0.071719159 0.059742639 0.014372620
## reser.d -0.21019257 0.108376950 0.273947675 -0.003059153 -0.002590296
## constant
## reer.d 3.228874e-16
## ctot.d -1.518428e-16
## tnt.d -2.582090e-16
## mre.d 1.601285e-15
## reser.d 1.306527e-16## MRE
A_mre <- matrix(c(1, 0, 0, 0, 0,
0, 1, 0, 0, 0,
0, 0, 1, 0, 0,
0, 0, 0, 0, 1),
nrow = 5, ncol = 4)
test_exo_mre <- alrtest(z = johansen_trace, A = A_mre, r = 1)
p_val_mre <- pchisq(test_exo_mre@teststat, df = 1, lower.tail = FALSE)
if(p_val_mre > 0.05) {
cat("Conclusion : Non rejet de H0 -> MRE est faiblement exogène \n\n")
} else {
cat("Conclusion : Rejet de H0 -> MRE n'est pas faiblement exogène \n\n")
}## Conclusion : Non rejet de H0 -> MRE est faiblement exogène## CTOT
A_ctot <- matrix(c(1, 0, 0, 0, 0,
0, 0, 1, 0, 0,
0, 0, 0, 1, 0,
0, 0, 0, 0, 1),
nrow = 5, ncol = 4)
test_exo_ctot <- alrtest(z = johansen_trace, A = A_ctot, r = 1)
p_val_ctot <- pchisq(test_exo_ctot@teststat, df = 1, lower.tail = FALSE)
if(p_val_ctot > 0.05) {
cat("Conclusion : Non rejet de H0 -> CTOT est faiblement exogène \n\n")
} else {
cat("Conclusion : Rejet de H0 \n\n")
}## Conclusion : Non rejet de H0 -> CTOT est faiblement exogène##TNT
A_tnt <- matrix(c(1, 0, 0, 0, 0, # Alpha 1 (reer)
0, 1, 0, 0, 0, # Alpha 2 (ctot)
0, 0, 0, 1, 0, # Alpha 4 (mre)
0, 0, 0, 0, 1), # Alpha 5 (reser)
nrow = 5, ncol = 4)
test_exo_tnt <- alrtest(z = johansen_trace, A = A_tnt, r = 1)
p_val_tnt <- pchisq(test_exo_tnt@teststat, df = 1, lower.tail = FALSE)
if(p_val_tnt > 0.05) {
cat("Conclusion : Non rejet de H0 -> TNT est faiblement exogène \n")
} else {
cat("Conclusion : Rejet de H0 -> TNT n'est pas faiblement exogène \n")
}## Conclusion : Rejet de H0 -> TNT n'est pas faiblement exogène## RESER
A_reser <- matrix(c(1, 0, 0, 0, 0, # Alpha 1 (reer)
0, 1, 0, 0, 0, # Alpha 2 (ctot)
0, 0, 1, 0, 0, # Alpha 3 (tnt)
0, 0, 0, 1, 0), # Alpha 4 (mre)
nrow = 5, ncol = 4)
test_exo_reser <- alrtest(z = johansen_trace, A = A_reser, r = 1)
p_val_reser <- pchisq(test_exo_reser@teststat, df = 1, lower.tail = FALSE)
if(p_val_reser > 0.05) {
cat("Conclusion : Non rejet de H0 -> RESER est faiblement exogène \n")
} else {
cat("Conclusion : Rejet de H0 -> RESER n'est pas faiblement exogène \n")
}## Conclusion : Non rejet de H0 -> RESER est faiblement exogène2. Validation de la Spécification et Diagnostics des Résidus :
Après avoir estimé notre Modèle à Vecteur à Correction d’Erreur (VECM), il convient d’interpréter la dynamique de retour à l’équilibre en termes temporels, et enfin de soumettre les résidus du modèle à une batterie de tests de diagnostic pour évaluer la robustesse de nos estimations.
2.1. Dynamique de Retour à l’Équilibre :
Pour donner un sens plus intuitif au coefficient d’ajustement (\(\alpha = -0.0662\)), nous calculons la demi-vie (half-life) des déviations. Il s’agit du temps nécessaire pour que la moitié de l’impact d’un choc éloignant le taux de change de son équilibre fondamental soit résorbée.
Formule et Résultat :
\[ Demi\_vie = \frac{\ln(2)}{|\alpha|} \]
\[ Demi\_vie = \frac{0.693}{|-0.0662|} \approx 10.5 \text{ mois} \]
chosen_ecdet <- "const"
jo_selected <- ca.jo(Y, type = "trace", ecdet = chosen_ecdet,
K = p_opt, spec = "transitory", dumvar = exo_mat)
summary(jo_selected)##
## ######################
## # Johansen-Procedure #
## ######################
##
## Test type: trace statistic , without linear trend and constant in cointegration
##
## Eigenvalues (lambda):
## [1] 1.346927e-01 8.113565e-02 7.188605e-02 4.395934e-02 1.779890e-02
## [6] -1.590050e-17
##
## Values of teststatistic and critical values of test:
##
## test 10pct 5pct 1pct
## r <= 4 | 4.71 7.52 9.24 12.97
## r <= 3 | 16.48 17.85 19.96 24.60
## r <= 2 | 36.03 32.00 34.91 41.07
## r <= 1 | 58.20 49.65 53.12 60.16
## r = 0 | 96.10 71.86 76.07 84.45
##
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1 constant
## reer.l1 1.00000000 1.0000000 1.0000000 1.0000000 1.00000000 1.000000
## ctot.l1 -0.52561189 1.0302092 0.3992124 -0.9842529 2.10680105 28.204979
## tnt.l1 -0.29100303 -0.7044182 0.1403102 -0.7883792 0.13657211 -6.585821
## mre.l1 0.06168909 0.1103258 0.1798662 -1.2734913 -0.07199194 7.629783
## reser.l1 -0.05668070 -0.1155818 -0.1729721 0.3145288 0.85467959 4.385058
## constant -4.54542667 -4.4597914 -4.3748981 -1.3814824 -8.93316098 -55.126174
##
## Weights W:
## (This is the loading matrix)
##
## reer.l1 ctot.l1 tnt.l1 mre.l1 reser.l1
## reer.d -0.06622583 0.041312805 -0.025801962 -0.001182462 -0.001147939
## ctot.d 0.01990337 -0.002222231 -0.008543333 0.002465998 -0.004779618
## tnt.d 0.24487102 0.100149393 -0.013333174 0.001221596 0.001478669
## mre.d -0.19792733 0.023997872 0.071719159 0.059742639 0.014372620
## reser.d -0.21019257 0.108376950 0.273947675 -0.003059153 -0.002590296
## constant
## reer.d 3.228874e-16
## ctot.d -1.518428e-16
## tnt.d -2.582090e-16
## mre.d 1.601285e-15
## reser.d 1.306527e-16jo_selected_eigen <- ca.jo(Y, type = "eigen", ecdet = chosen_ecdet,
K = p_opt, spec = "transitory", dumvar = exo_mat)
r_opt <- 1
vecm_final <- cajorls(jo_selected, r = r_opt)
beta_raw <- vecm_final$beta
beta_norm <- -(beta_raw / beta_raw[1, 1])
print(round(beta_norm, 5))## ect1
## reer.l1 -1.00000
## ctot.l1 0.52561
## tnt.l1 0.29100
## mre.l1 -0.06169
## reser.l1 0.05668
## constant 4.54543alpha_mat <- jo_selected@W[, 1, drop = FALSE]
cat(sprintf("alpha_reer = %.5f\n", alpha_mat[1, 1]))## alpha_reer = -0.06623cat(sprintf("Half-life = %.1f months\n", log(2) / abs(alpha_mat[1, 1])))## Half-life = 10.5 monthstrace_r1 <- jo_selected@teststat[which(rownames(jo_selected@cval) == "r <= 1")]
cv5_r1 <- jo_selected@cval[rownames(jo_selected@cval) == "r <= 1", "5pct"]
maxeig_r1 <- jo_selected_eigen@teststat[rownames(jo_selected_eigen@cval) == "r <= 1"]
cv5_maxeig <- jo_selected_eigen@cval[rownames(jo_selected_eigen@cval) == "r <= 1", "5pct"]
cat(sprintf("Trace r<=1: stat=%.2f vs CV5=%.2f → %s\n",
trace_r1, cv5_r1,
ifelse(trace_r1 > cv5_r1, "reject (suggests r≥2)", "fail to reject")))
cat(sprintf("Max-eig r<=1: stat=%.2f vs CV5=%.2f → %s\n",
maxeig_r1, cv5_maxeig,
ifelse(maxeig_r1 > cv5_maxeig, "reject", "fail to reject (supports r=1)")))
var_from_vecm <- vec2var(jo_selected, r = r_opt)
print(serial.test(var_from_vecm, lags.pt = 12, type = "PT.asymptotic"))##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 384.66, df = 255, p-value = 2.701e-07## $serial
##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 384.66, df = 255, p-value = 2.701e-07print(normality.test(var_from_vecm))## $JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8817.2, df = 10, p-value < 2.2e-16
##
##
## $Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 325.76, df = 5, p-value < 2.2e-16
##
##
## $Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8491.5, df = 5, p-value < 2.2e-16## $jb.mul
## $jb.mul$JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8817.2, df = 10, p-value < 2.2e-16
##
##
## $jb.mul$Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 325.76, df = 5, p-value < 2.2e-16
##
##
## $jb.mul$Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8491.5, df = 5, p-value < 2.2e-16print(arch.test(var_from_vecm, lags.multi = 5, multivariate.only = TRUE))##
## ARCH (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 1897.4, df = 1125, p-value < 2.2e-16## $arch.mul
##
## ARCH (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 1897.4, df = 1125, p-value < 2.2e-163 Modèle à Correction d’Erreur (VECM) et Significativité de Long Terme :
L’existence d’une relation de cointégration justifie l’estimation d’un Modèle à Vecteur à Correction d’Erreur (VECM). Ce modèle permet d’analyser simultanément la dynamique d’ajustement de court terme et la relation d’équilibre de long terme, tout en mesurant l’impact des chocs exogènes via nos variables indicatrices.
3.1. Dynamique de Court Terme et Vitesse d’Ajustement (VECM) :
L’équation estimée prend la forme suivante : \[ \Delta REER_t = \alpha \hat{ECT}_{t-1} + \sum_{i=1}^{p-1} \Gamma_i \Delta X_{t-i} + \Theta D_t + \epsilon_t \] (où \(\hat{ECT}_{t-1}\) est le terme d’erreur dérivé de la relation de cointégration, \(\Delta X\) représente les fondamentaux en différences, et \(D_t\) la matrice des variables muettes exogènes).
Interprétation (Équation reer.d) :Le mécanisme de correction d’erreur (ECT1) :Le coefficient \(\alpha\) (la force de rappel) est estimé à -0.0662. Il est négatif et statistiquement très significatif (p-value = 0.00696).
Le mécanisme de correction d’erreur est validé de manière robuste. Lorsqu’un déséquilibre survient, le taux de change réel s’ajuste vers sa valeur fondamentale d’équilibre à un rythme d’environ 6.6 % par mois.
Impact des chocs exogènes (Variables Muettes) :Le passage à un régime de change plus flexible (dum_float) a un impact positif et significatif à court terme (+0.0034, p = 0.028).Le choc de la guerre en Ukraine (dum_ukraine) a induit une dépréciation réelle immédiate et significative (-0.0039, p = 0.003). Les chocs pétrolier de 2015 et du COVID-19 n’affichent pas de significativité stricte au seuil de 5% sur l’équation du REER.
Dynamique des fondamentaux à court terme :Aucune des variables fondamentales retardées en différences (ctot.dl1, tnt.dl1, mre.dl1, reser.dl1) n’est statistiquement significative.
3.2. Tests de Significativité des Fondamentaux de Long Terme (Test LR) :
Les coefficients du vecteur de cointégration (le \(\beta\) normalisé) calculés par la procédure de Johansen indiquent une élasticité, mais ne sont pas accompagnés de tests de significativité standards (t-Student). Pour vérifier si chaque fondamental contribue réellement à la définition du taux de change d’équilibre, nous utilisons un test du Rapport de Vraisemblance (Likelihood Ratio - LR) consistant à imposer une restriction nulle sur chaque coefficient \(\beta_i\).
Hypothèses du test LR :
\(H_0 : \beta_i = 0\) (La variable ne joue aucun rôle dans la relation de long terme).
\(H_1 : \beta_i \neq 0\) (La variable est un déterminant significatif de l’équilibre).
Statistique de test :La statistique LR compare la vraisemblance du modèle non contraint avec celle du modèle où le coefficient est forcé à zéro. Elle suit une loi du \(\chi^2\) à 1 degré de liberté.
Résultats : L’analyse des restrictions révèle une dichotomie claire parmi nos variables fondamentales :
Variables Significatives (ctot et tnt) :
Termes de l'échange (CTOT) : LR = 7.0703, p-value = 0.0078. On rejette fermement $H_0$. L'effet de richesse lié aux termes de l'échange est un déterminant majeur et robuste de l'équilibre du dirham.
Ratio Non-échangeables/Échangeables (TNT) : LR = 6.0720, p-value = 0.0137. On rejette $H_0$. L'effet Balassa-Samuelson explique structurellement la trajectoire d'équilibre du REER.Variables Non-Significatives (mre et reser) :
Transferts des MRE (MRE) : LR = 2.1357, p-value = 0.1439. On ne rejette pas $H_0$.
Réserves de change (RESER) : LR = 2.7892, p-value = 0.0949. On ne rejette pas $H_0$.r_opt <- 1
vecm_model <- cajorls(johansen_trace, r = r_opt)
summary(vecm_model$rlm)## Response reer.d :
##
## Call:
## lm(formula = reer.d ~ ect1 + dum_crise + dum_oil + dum_float +
## dum_covid + dum_ukraine + reer.dl1 + ctot.dl1 + tnt.dl1 +
## mre.dl1 + reser.dl1 - 1, data = data.mat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.027030 -0.002952 -0.000193 0.001853 0.048269
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## ect1 -0.066226 0.024336 -2.721 0.00696 **
## dum_crise -0.002906 0.001649 -1.762 0.07923 .
## dum_oil -0.002116 0.001295 -1.633 0.10363
## dum_float 0.003414 0.001540 2.217 0.02752 *
## dum_covid -0.004120 0.003203 -1.286 0.19957
## dum_ukraine -0.003916 0.001313 -2.983 0.00314 **
## reer.dl1 -0.332688 0.059333 -5.607 5.41e-08 ***
## ctot.dl1 -0.041412 0.063156 -0.656 0.51262
## tnt.dl1 -0.004295 0.024789 -0.173 0.86259
## mre.dl1 -0.010472 0.007929 -1.321 0.18782
## reser.dl1 0.010842 0.011968 0.906 0.36586
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005655 on 251 degrees of freedom
## Multiple R-squared: 0.1739, Adjusted R-squared: 0.1377
## F-statistic: 4.804 on 11 and 251 DF, p-value: 1.028e-06
##
##
## Response ctot.d :
##
## Call:
## lm(formula = ctot.d ~ ect1 + dum_crise + dum_oil + dum_float +
## dum_covid + dum_ukraine + reer.dl1 + ctot.dl1 + tnt.dl1 +
## mre.dl1 + reser.dl1 - 1, data = data.mat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0182605 -0.0027332 0.0002306 0.0035171 0.0207606
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## ect1 0.0199034 0.0235824 0.844 0.39948
## dum_crise -0.0019060 0.0015978 -1.193 0.23404
## dum_oil -0.0001251 0.0012554 -0.100 0.92067
## dum_float -0.0008097 0.0014921 -0.543 0.58784
## dum_covid 0.0056212 0.0031042 1.811 0.07136 .
## dum_ukraine 0.0023082 0.0012722 1.814 0.07084 .
## reer.dl1 -0.0232826 0.0574960 -0.405 0.68586
## ctot.dl1 0.3110936 0.0612006 5.083 7.26e-07 ***
## tnt.dl1 0.0419325 0.0240210 1.746 0.08209 .
## mre.dl1 -0.0039374 0.0076838 -0.512 0.60880
## reser.dl1 -0.0384602 0.0115977 -3.316 0.00105 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.00548 on 251 degrees of freedom
## Multiple R-squared: 0.2086, Adjusted R-squared: 0.1739
## F-statistic: 6.015 on 11 and 251 DF, p-value: 1.031e-08
##
##
## Response tnt.d :
##
## Call:
## lm(formula = tnt.d ~ ect1 + dum_crise + dum_oil + dum_float +
## dum_covid + dum_ukraine + reer.dl1 + ctot.dl1 + tnt.dl1 +
## mre.dl1 + reser.dl1 - 1, data = data.mat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.037194 -0.007327 -0.000614 0.006113 0.098960
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## ect1 0.2448710 0.0592799 4.131 4.93e-05 ***
## dum_crise 0.0008491 0.0040165 0.211 0.832744
## dum_oil 0.0067411 0.0031556 2.136 0.033629 *
## dum_float -0.0037984 0.0037509 -1.013 0.312195
## dum_covid -0.0015653 0.0078031 -0.201 0.841179
## dum_ukraine 0.0017631 0.0031981 0.551 0.581928
## reer.dl1 0.0832151 0.1445297 0.576 0.565290
## ctot.dl1 0.5728679 0.1538420 3.724 0.000242 ***
## tnt.dl1 0.0986009 0.0603824 1.633 0.103735
## mre.dl1 0.0103636 0.0193150 0.537 0.592050
## reser.dl1 0.0023128 0.0291534 0.079 0.936832
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.01377 on 251 degrees of freedom
## Multiple R-squared: 0.1258, Adjusted R-squared: 0.0875
## F-statistic: 3.284 on 11 and 251 DF, p-value: 0.0003175
##
##
## Response mre.d :
##
## Call:
## lm(formula = mre.d ~ ect1 + dum_crise + dum_oil + dum_float +
## dum_covid + dum_ukraine + reer.dl1 + ctot.dl1 + tnt.dl1 +
## mre.dl1 + reser.dl1 - 1, data = data.mat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.090392 -0.024385 -0.003007 0.024138 0.186470
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## ect1 -0.1979273 0.1748854 -1.132 0.25882
## dum_crise 0.0070499 0.0118494 0.595 0.55240
## dum_oil -0.0005777 0.0093097 -0.062 0.95057
## dum_float 0.0035171 0.0110656 0.318 0.75087
## dum_covid 0.0173706 0.0230205 0.755 0.45121
## dum_ukraine 0.0003836 0.0094349 0.041 0.96760
## reer.dl1 0.2406388 0.4263866 0.564 0.57301
## ctot.dl1 -1.4060246 0.4538593 -3.098 0.00217 **
## tnt.dl1 0.0680349 0.1781379 0.382 0.70284
## mre.dl1 -0.4531209 0.0569823 -7.952 6.27e-14 ***
## reser.dl1 0.0597854 0.0860074 0.695 0.48762
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04064 on 251 degrees of freedom
## Multiple R-squared: 0.23, Adjusted R-squared: 0.1962
## F-statistic: 6.815 on 11 and 251 DF, p-value: 5.065e-10
##
##
## Response reser.d :
##
## Call:
## lm(formula = reser.d ~ ect1 + dum_crise + dum_oil + dum_float +
## dum_covid + dum_ukraine + reer.dl1 + ctot.dl1 + tnt.dl1 +
## mre.dl1 + reser.dl1 - 1, data = data.mat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.097460 -0.018530 0.001914 0.017667 0.094658
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## ect1 -0.210193 0.130942 -1.605 0.1097
## dum_crise -0.001646 0.008872 -0.185 0.8530
## dum_oil -0.001493 0.006970 -0.214 0.8305
## dum_float 0.001877 0.008285 0.226 0.8210
## dum_covid 0.025111 0.017236 1.457 0.1464
## dum_ukraine -0.002799 0.007064 -0.396 0.6923
## reer.dl1 0.310770 0.319250 0.973 0.3313
## ctot.dl1 0.360093 0.339819 1.060 0.2903
## tnt.dl1 -0.069411 0.133378 -0.520 0.6032
## mre.dl1 0.017941 0.042665 0.421 0.6745
## reser.dl1 0.135832 0.064397 2.109 0.0359 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03043 on 251 degrees of freedom
## Multiple R-squared: 0.07378, Adjusted R-squared: 0.03319
## F-statistic: 1.818 on 11 and 251 DF, p-value: 0.05147print(vecm_model$beta)## ect1
## reer.l1 1.00000000
## ctot.l1 -0.52561189
## tnt.l1 -0.29100303
## mre.l1 0.06168909
## reser.l1 -0.05668070
## constant -4.54542667beta_norm <- vecm_model$beta / vecm_model$beta[1, 1]
beta_norm <- -beta_norm
print(beta_norm)## ect1
## reer.l1 -1.00000000
## ctot.l1 0.52561189
## tnt.l1 0.29100303
## mre.l1 -0.06168909
## reser.l1 0.05668070
## constant 4.54542667# Test de significativité des coefficients de cointegration
variables_a_tester <- list(ctot = 2, tnt = 3, mre = 4, reser = 5)
for (nom in names(variables_a_tester)) {
idx <- variables_a_tester[[nom]]
H <- matrix(0, nrow = 6, ncol = 5)
col_ptr <- 1
for (i in 1:6) {
if (i != idx) {
H[i, col_ptr] <- 1
col_ptr <- col_ptr + 1
}
}
test_lr <- blrtest(z = johansen_trace, H = H, r = 1)
stat_lr <- test_lr@teststat
p_val <- pchisq(stat_lr, df = 1, lower.tail = FALSE)
cat(sprintf("Variable ciblée : %s\n", toupper(nom)))
cat(sprintf("Statistique LR = %.4f\n", stat_lr))
cat(sprintf("p-value = %.4f\n", p_val))
if (p_val < 0.05) {
cat("Conclusion : Rejet de H0 -> Le coefficient EST significatif (***)\n")
} else if (p_val < 0.10) {
cat("Conclusion : Rejet de H0 -> Le coefficient EST significatif à 10% (*)\n")
} else {
cat("Conclusion : Non rejet de H0 -> Le coefficient N'EST PAS significatif (ns)\n")
}
}## Variable ciblée : CTOT
## Statistique LR = 7.0703
## p-value = 0.0078
## Conclusion : Rejet de H0 -> Le coefficient EST significatif (***)
## Variable ciblée : TNT
## Statistique LR = 6.0720
## p-value = 0.0137
## Conclusion : Rejet de H0 -> Le coefficient EST significatif (***)
## Variable ciblée : MRE
## Statistique LR = 2.1357
## p-value = 0.1439
## Conclusion : Non rejet de H0 -> Le coefficient N'EST PAS significatif (ns)
## Variable ciblée : RESER
## Statistique LR = 2.7892
## p-value = 0.0949
## Conclusion : Rejet de H0 -> Le coefficient EST significatif à 10% (*)3.3 Estimation de la Relation de Long Terme : Approches FMOLS et DOLS :
Comme nous l’avons constaté lors du diagnostic du VECM, les résidus de notre système multivarié rejettent les hypothèses de normalité, d’homoscédasticité (effets ARCH) et d’absence d’autocorrélation. Bien que l’estimateur de Johansen soit super-convergent, en échantillon fini, ces violations peuvent affecter la validité des tests d’inférence (comme le test LR précédent qui rejetait la significativité de mre et reser).Pour pallier ce problème et consolider l’estimation de notre taux de change d’équilibre (BEER), la littérature recommande d’estimer la relation de cointégration par des méthodes à équation unique robustes à l’endogénéité et à l’autocorrélation des erreurs : les estimateurs FMOLS (Fully Modified OLS) et DOLS (Dynamic OLS).
A. Estimateur FMOLS (Phillips et Hansen, 1990) :
L’estimateur FMOLS applique une correction semi-paramétrique aux Moindres Carrés Ordinaires. Il modifie les données pour éliminer les biais liés à la corrélation de long terme entre l’équation de cointégration et les équations des variables explicatives (endogénéité), tout en corrigeant l’autocorrélation sérielle des résidus via un noyau (ici, le noyau de Bartlett/Andrews). L’équation de long terme estimée par FMOLS s’écrit :
\[ REER = 0.1687 ctot + 0.2685 tnt - 0.0914 mre + 0.0779 reser + 4.5515 \] Significativité : Contrairement au test LR de Johansen, toutes les variables sont ici hautement significatives (p-values approchant 0). L’approche FMOLS réhabilite totalement les transferts MRE et les réserves de change comme des déterminants structurels du taux de change d’équilibre marocain.
B. Estimateur DOLS (Stock et Watson, 1993) :
L’estimateur DOLS traite les mêmes problèmes que le FMOLS, mais via une correction purement paramétrique. Il consiste à inclure dans la régression les différences premières des variables explicatives, ainsi que leurs retards (lags) et leurs valeurs futures (leads), afin “d’absorber” la dynamique de court terme et l’endogénéité. Pour nos données mensuelles, nous avons spécifié 2 leads et 2 lags.
Résultats de l’estimation :L’équation de long terme estimée par DOLS s’écrit :
\[ REER = 0.1937 ctot + 0.2364 tnt - 0.0875 mre + 0.0846 reser + 4.4996 \] Significativité :Ici encore, l’intégralité des fondamentaux est statistiquement significative au seuil de 5% (et au seuil de 1% pour toutes les variables sauf ctot qui l’est à près de 2%).
Validation des MRE et Réserves : L’usage de méthodes robustes (FMOLS/DOLS) permet de valider statistiquement la présence des MRE et des réserves de change dans la spécification du modèle, contournant ainsi le rejet du test LR induit par la non-normalité des résidus du VECM.
var_from_vecm <- vec2var(johansen_trace, r = r_opt)
serial_test <- serial.test(var_from_vecm, lags.pt = 12, type = "PT.asymptotic")
print(serial_test)##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 384.66, df = 255, p-value = 2.701e-07## $serial
##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 384.66, df = 255, p-value = 2.701e-07norm_test <- normality.test(var_from_vecm)
print(norm_test)## $JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8817.2, df = 10, p-value < 2.2e-16
##
##
## $Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 325.76, df = 5, p-value < 2.2e-16
##
##
## $Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8491.5, df = 5, p-value < 2.2e-16## $jb.mul
## $jb.mul$JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8817.2, df = 10, p-value < 2.2e-16
##
##
## $jb.mul$Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 325.76, df = 5, p-value < 2.2e-16
##
##
## $jb.mul$Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 8491.5, df = 5, p-value < 2.2e-16arch_test <- arch.test(var_from_vecm, lags.multi = 5, multivariate.only = TRUE)
print(arch_test)##
## ARCH (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 1897.4, df = 1125, p-value < 2.2e-16## $arch.mul
##
## ARCH (multivariate)
##
## data: Residuals of VAR object var_from_vecm
## Chi-squared = 1897.4, df = 1125, p-value < 2.2e-16y <- as.numeric(df_clean$reer)
X <- as.matrix(df_clean[, c("ctot", "tnt", "mre", "reser")])
deter <- matrix(1, nrow = length(y), ncol = 1)
colnames(deter) <- "constante"
modele_fmols <- cointRegFM(x = X, y = y, deter = deter)
print(modele_fmols)##
## ### FM-OLS model ###
##
## Model: y ~ deter + X
##
## Parameters: Kernel = "ba" // Bandwidth = 20.95881 ("Andrews")
##
## Coefficients:
## Estimate Std.Err t value Pr(|t|>0)
## constante 4.551571 0.064540 70.5229 < 2.2e-16 ***
## ctot 0.168737 0.062750 2.6890 0.007631 **
## tnt 0.268512 0.030516 8.7989 < 2.2e-16 ***
## mre -0.091477 0.010784 -8.4830 1.705e-15 ***
## reser 0.077927 0.014715 5.2957 2.533e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1modele_dols <- cointRegD(x = X, y = y, deter = deter, n.lead = 2, n.lag = 2)
print(modele_dols)##
## ### D-OLS model ###
##
## Model: y ~ deter + X
##
## Parameters: Kernel = "ba" // Bandwidth = 20.79318 ("Andrews")
##
## Leads = 2 / Lags = 2 (set manually)
##
## Coefficients:
## Estimate Std.Err t value Pr(|t|>0)
## constante 4.499655 0.085417 52.6788 < 2.2e-16 ***
## ctot 0.193763 0.082543 2.3474 0.01966 *
## tnt 0.236487 0.039089 6.0500 5.046e-09 ***
## mre -0.087597 0.013124 -6.6744 1.501e-10 ***
## reser 0.084682 0.019165 4.4185 1.462e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 14. Taux de Change d’Équilibre (BEER) et Analyse des Mésalignements :
L’objectif final de cette étude est d’estimer la trajectoire du taux de change fondamental d’équilibre du Maroc et d’en déduire les périodes de mésalignement de la monnaie nationale. Pour ce faire, nous nous appuyons sur l’approche BEER (Behavioral Equilibrium Exchange Rate), en utilisant les élasticités robustes issues de notre estimation DOLS.
4.1. Construction de la Trajectoire d’Équilibre (BEER) :
Le Taux de Change d’Équilibre (BEER) est calculé comme la combinaison linéaire des fondamentaux macroéconomiques observés, pondérés par les coefficients de long terme. Conformément à notre code, cette trajectoire est calculée à l’état brut, c’est-à-dire sans appliquer de lissage statistique préalable (tel qu’un filtre Hodrick-Prescott) sur les fondamentaux, afin de capturer l’équilibre dicté par les conditions réelles du marché à chaque instant \(t\). L’équation comportementale s’écrit :
\[ BEER_t = 4.4997 + 0.1938 \times ctot_t + 0.2365 \times tnt_t - 0.0876 \times mre_t + 0.0847 \times reser_t \]
4.2. Validation du Modèle : Stationnarité de l’Écart (ECT) :
Avant d’interpréter économiquement le mésalignement, il est crucial de vérifier que l’écart entre le REER observé et le BEER estimé (soit le terme d’erreur \(ECT = REER - BEER\)) est bien stationnaire. Si cet écart présentait une racine unitaire, cela signifierait que le taux de change s’éloigne indéfiniment de ses fondamentaux, invalidant l’existence d’un équilibre.
Résultats des tests de racine unitaire sur l’ECT : Pour garantir une robustesse maximale, nous avons confronté le test ADF (qui teste la non-stationnarité) au test KPSS (qui teste la stationnarité) :
Test ADF (sans dérive ni tendance) : La statistique de test est de -3.4857, ce qui est largement inférieur à la valeur critique au seuil de 1% (-2.58). Nous rejetons l’hypothèse de racine unitaire.
Test KPSS (avec dérive) : La statistique est de 0.169, ce qui est très inférieur à la valeur critique de 5% (0.463). Nous ne rejetons pas l’hypothèse de stationnarité.
Les deux tests convergent parfaitement. Le mésalignement (\(ECT\)) est strictement intégré d’ordre 0, soit \(I(0)\). La relation de long terme est solide, et les écarts du dirham par rapport à ses fondamentaux sont de nature transitoire (phénomène de retour à la moyenne).
4.3. Évolution des Mésalignements du Dirham :
Le mésalignement est calculé comme le pourcentage de déviation du taux de change observé par rapport à son niveau d’équilibre fondamental :
\[ M\acute{e}salignement_t = \left( \frac{REER_t - BEER_t}{BEER_t} \right) \times 100 \] Un mésalignement positif indique une surévaluation (la monnaie est plus forte que ce que dictent les fondamentaux).Un mésalignement négatif indique une sous-évaluation (la monnaie est plus faible que son équilibre).
cst <- modele_dols$theta[1]
b_ctot <- modele_dols$theta[2]
b_tnt <- modele_dols$theta[3]
b_mre <- modele_dols$theta[4]
b_reser <- modele_dols$theta[5]
n_obs <- min(
length(reer_clean),
length(ctot_clean),
length(tnt_clean),
length(mre_clean),
length(reser_clean)
)
reer_vec <- as.numeric(reer_clean)[1:n_obs]
ctot_vec <- as.numeric(ctot_clean)[1:n_obs]
tnt_vec <- as.numeric(tnt_clean)[1:n_obs]
mre_vec <- as.numeric(mre_clean)[1:n_obs]
reser_vec <- as.numeric(reser_clean)[1:n_obs]
dates_vec <- seq(
from = as.Date("2004-01-01"),
by = "month",
length.out = n_obs
)
BEER <- cst + b_ctot * ctot_vec + b_tnt * tnt_vec +
b_mre * mre_vec + b_reser * reser_vec
ECT_raw <- reer_vec - BEER
misalign_pct <- ECT_raw * 100
resultats_beer <- data.frame(
Date = dates_vec,
REER_Observe = reer_vec,
BEER_Equil = BEER,
ECT = ECT_raw,
Misalignment = misalign_pct,
Direction = ifelse(misalign_pct > 0, "Surévaluation", "Sous-évaluation")
)
g1 <- ggplot(resultats_beer, aes(x = Date)) +
geom_ribbon(
aes(ymin = pmin(REER_Observe, BEER_Equil),
ymax = pmax(REER_Observe, BEER_Equil),
fill = REER_Observe > BEER_Equil),
alpha = 0.20
) +
scale_fill_manual(
values = c("TRUE" = "#c0392b", "FALSE" = "#27ae60"),
labels = c("TRUE" = "Surévaluation", "FALSE" = "Sous-évaluation"),
name = "Zone"
) +
geom_line(aes(y = REER_Observe, colour = "REER Observé"),
linewidth = 1.1) +
geom_line(aes(y = BEER_Equil, colour = "BEER Équilibre"),
linewidth = 1.0, linetype = "dashed") +
scale_colour_manual(
values = c("REER Observé" = "#2c3e50",
"BEER Équilibre" = "#e74c3c"),
name = NULL
) +
labs(
title = "Taux de Change Effectif Réel — Observé vs Équilibre BEER",
subtitle = "Relation de cointégration sans filtre HP | Données mensuelles 2004–2025",
x = NULL,
y = "Log(REER)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(colour = "grey50", size = 10),
legend.position = "bottom",
panel.grid.minor = element_blank()
)
print(g1)
g2 <- ggplot(resultats_beer, aes(x = Date, y = Misalignment)) +
geom_col(aes(fill = Misalignment > 0),
width = 25,
show.legend = FALSE) +
scale_fill_manual(values = c("TRUE" = "#c0392b",
"FALSE" = "#27ae60")) +
geom_hline(yintercept = 0,
colour = "black",
linewidth = 0.7) +
geom_hline(yintercept = 5,
colour = "grey40",
linewidth = 0.4,
linetype = "dotted") +
geom_hline(yintercept = -5,
colour = "grey40",
linewidth = 0.4,
linetype = "dotted") +
annotate("text",
x = min(resultats_beer$Date),
y = 5.3,
label = "+5%",
size = 3,
colour = "grey40",
hjust = 0) +
annotate("text",
x = min(resultats_beer$Date),
y = -5.3,
label = "−5%",
size = 3,
colour = "grey40",
hjust = 0) +
scale_x_date(
date_breaks = "1 year",
date_labels = "%Y"
) +
scale_y_continuous(
breaks = seq(
floor(min(resultats_beer$Misalignment, na.rm = TRUE)),
ceiling(max(resultats_beer$Misalignment, na.rm = TRUE)),
by = 1
)
) +
labs(
title = "Mésalignement du Dirham Marocain (%)",
subtitle = "Rouge = Surévaluation | Vert = Sous-évaluation",
x = NULL,
y = "Écart REER − BEER (%)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(colour = "grey50", size = 10),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)
)
g2
print(g2)
g3 <- ggplot(resultats_beer, aes(x = Date, y = ECT)) +
geom_line(colour = "#2980b9", linewidth = 0.9) +
geom_hline(yintercept = 0, colour = "black", linewidth = 0.7) +
geom_hline(yintercept = mean(ECT_raw) + 2*sd(ECT_raw),
colour = "#c0392b", linewidth = 0.4, linetype = "dashed") +
geom_hline(yintercept = mean(ECT_raw) - 2*sd(ECT_raw),
colour = "#27ae60", linewidth = 0.4, linetype = "dashed") +
annotate("text",
x = max(dates_vec),
y = mean(ECT_raw) + 2*sd(ECT_raw) + 0.001,
label = "+2σ", size = 3, colour = "#c0392b", hjust = 1) +
annotate("text",
x = max(dates_vec),
y = mean(ECT_raw) - 2*sd(ECT_raw) - 0.001,
label = "−2σ", size = 3, colour = "#27ae60", hjust = 1) +
labs(
title = "Terme d'Erreur de Cointégration (ECT)",
subtitle = "Doit être stationnaire autour de zéro — force de rappel vers l'équilibre",
x = NULL,
y = "ECT = REER − BEER"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(colour = "grey50", size = 10),
panel.grid.minor = element_blank()
)
print(g3)
contrib_df <- data.frame(
Date = dates_vec,
Constante = rep(cst, n_obs),
ctot = b_ctot * ctot_vec,
tnt = b_tnt * tnt_vec,
mre = b_mre * mre_vec,
reser = b_reser * reser_vec
)
contrib_long <- tidyr::pivot_longer(
contrib_df,
cols = -Date,
names_to = "Composante",
values_to = "Contribution"
)
contrib_long$Composante <- factor(
contrib_long$Composante,
levels = c("Constante", "ctot", "tnt", "mre", "reser")
)
g4 <- ggplot(contrib_long, aes(x = Date, y = Contribution,
colour = Composante)) +
geom_line(linewidth = 0.8) +
scale_colour_manual(
values = c(
"Constante" = "grey60",
"ctot" = "#e67e22",
"tnt" = "#9b59b6",
"mre" = "#27ae60",
"reser" = "#2980b9"
)
) +
labs(
title = "Contribution des Fondamentaux au BEER",
subtitle = "Décomposition additive de la valeur d'équilibre",
x = NULL,
y = "Contribution (log)",
colour = "Fondamental"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(colour = "grey50", size = 10),
legend.position = "bottom",
panel.grid.minor = element_blank()
)
print(g4)
adf_ect <- ur.df(ECT_raw, type = "none", lags = 4, selectlags = "AIC")
print(summary(adf_ect))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression none
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.035244 -0.003244 0.000040 0.003254 0.052437
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.11860 0.03402 -3.486 0.000577 ***
## z.diff.lag -0.25604 0.06029 -4.247 3.03e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.007302 on 257 degrees of freedom
## Multiple R-squared: 0.1401, Adjusted R-squared: 0.1334
## F-statistic: 20.94 on 2 and 257 DF, p-value: 3.754e-09
##
##
## Value of test-statistic is: -3.4857
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.58 -1.95 -1.62kpss_ect <- ur.kpss(ECT_raw, type = "mu", lags = "short")
print(summary(kpss_ect))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 5 lags.
##
## Value of test-statistic is: 0.169
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739var_level <- vec2var(johansen_trace, r = 1)
irf_mre <- irf(var_level, impulse = "mre", response = "reer",
n.ahead = 24, boot = TRUE, runs = 100)
irf_ctot <- irf(var_level, impulse = "ctot", response = "reer",
n.ahead = 24, boot = TRUE, runs = 100)
par(mfrow = c(1, 2))
plot(irf_mre, main = "Choc MRE -> Rép. REER")
plot(irf_ctot, main = "Choc CTOT -> Rép. REER")
par(mfrow = c(1, 1))fevd_reer <- fevd(var_level, n.ahead = 24)
cat(" FEVD du REER (Horizon 1 an / 12 mois) \n")## FEVD du REER (Horizon 1 an / 12 mois)print(round(fevd_reer$reer[12, ] * 100, 2))## reer ctot tnt mre reser
## 87.91 5.80 4.26 1.22 0.81cat("\n FEVD du REER (Horizon 2 ans / 24 mois) \n")##
## FEVD du REER (Horizon 2 ans / 24 mois)print(round(fevd_reer$reer[24, ] * 100, 2))## reer ctot tnt mre reser
## 80.05 10.54 7.13 1.59 0.69plot(fevd_reer, main = "Décomposition de la variance du REER")
eq_long_terme <- REER_Observe ~ ctot_vec + tnt_vec + mre_vec + reser_vec
cusum_test <- efp(eq_long_terme, data = resultats_beer, type = "Rec-CUSUM")
cusum_sq_test <- efp(eq_long_terme, data = resultats_beer, type = "Rec-CUSUM")
par(mfrow = c(1, 2))
plot(cusum_test, main = "Test CUSUM (Stabilité de la moyenne)")
plot(efp(eq_long_terme, data = resultats_beer, type = "Rec-CUSUM"), functional = NULL, main = "Test CUSUM (Bandes de confiance)")
par(mfrow = c(1, 1))
sctest(cusum_test)##
## Recursive CUSUM test
##
## data: cusum_test
## S = 0.79237, p-value = 0.145Taux de Change d’Équilibre Permanent : Lissage par Filtre Hodrick-Prescott (HP)
Bien que la relation de cointégration estimée précédemment soit robuste, le Taux de Change d’Équilibre (BEER) calculé directement à partir des séries brutes intègre encore la volatilité de court terme (le “bruit”) présente dans les variables macroéconomiques fondamentales. Pour isoler la véritable trajectoire de long terme, c’est-à-dire l’équilibre “permanent” ou “structurel”, la littérature préconise de lisser les fondamentaux avant de calculer le BEER.
Méthodologie et Application du Filtre HPObjectif :
Le filtre de Hodrick-Prescott (HP) permet de décomposer une série temporelle en une composante cyclique (transitoire) et une composante tendancielle (permanente). Seule la composante permanente des fondamentaux est retenue pour reconstituer le taux de change d’équilibre.Paramétrage :Pour des données de fréquence mensuelle, la littérature (notamment Ravn et Uhlig, 2002) recommande un paramètre de lissage \(\lambda = 14400\). Nous appliquons ce filtre aux séries préalablement corrigées des variations saisonnières : ctot, tnt, mre et reser.Le BEER “permanent” (ou lissé) est ensuite recalculé en utilisant les coefficients issus de notre estimation DOLS : \[ BEER_{HP} = 4.4997 + 0.1938 \times ctot_{trend} + 0.2365 \times tnt_{trend} - 0.0876 \times mre_{trend} + 0.0847 \times reser_{trend} \] Comparaison des Mésalignements (Brut vs Lissé) :
Analyse :L’observation du graphique comparatif confirme la pertinence de cette approche. Le mésalignement calculé avec le filtre HP (courbe bleue) suit la même trajectoire globale que le mésalignement sans filtre (courbe en pointillés), mais en lissant la volatilité de court terme.
Validation Économétrique de l’Équilibre Permanent :
Objectif : Afin de valider définitivement ce nouveau BEER lissé comme cible de long terme, nous devons nous assurer que le nouvel écart (le terme d’erreur \(ECT_{HP} = REER - BEER_{HP}\)) conserve ses propriétés de stationnarité.
Résultats des tests sur l’ECT lissé :
Test ADF (sans dérive ni tendance) : La statistique de test s'élève à -3.2655, une valeur nettement inférieure à la valeur critique au seuil de 1% (-2.58). On rejette fortement la présence d'une racine unitaire.
Test KPSS (avec dérive) : La statistique est de 0.1774, bien en deçà de la valeur critique à 5% (0.463). On ne rejette pas l'hypothèse de stationnarité.Conclusion Générale :Le terme d’erreur issu des fondamentaux lissés est un processus \(I(0)\) parfaitement stationnaire. Le Taux de Change d’Équilibre Comportemental (BEER) dérivé de la composante tendancielle des fondamentaux (Termes de l’échange, Effet Balassa-Samuelson, Transferts MRE et Réserves de change) constitue un ancrage nominal robuste pour le dirham marocain. Les mésalignements récents sont minimes et tendent vers une légère sous-évaluation, confirmant la résilience et la pertinence du régime de change actuel de l’économie marocaine.
hp_filter <- function(series, lambda = 14400) {
hpfilter(series, freq = lambda, type = "lambda")
}
hp_ctot <- hp_filter(ctot_clean)
hp_tnt <- hp_filter(tnt_clean)
hp_mre <- hp_filter(mre_clean)
hp_reser <- hp_filter(reser_clean)
hp_reer <- hp_filter(reer_clean)
ctot_perm <- hp_ctot$trend
tnt_perm <- hp_tnt$trend
mre_perm <- hp_mre$trend
reser_perm <- hp_reser$trend
reer_perm <- hp_reer$trend
par(mfrow = c(2, 2))
plot(ctot_clean, col = "grey70", main = "CTOT — observed vs trend")
lines(ctot_perm, col = "#e67e22", lwd = 2)
plot(tnt_clean, col = "grey70", main = "TNT — observed vs trend")
lines(tnt_perm, col = "#9b59b6", lwd = 2)
plot(mre_clean, col = "grey70", main = "MRE — observed vs trend")
lines(mre_perm, col = "#27ae60", lwd = 2)
plot(reser_clean, col = "grey70", main = "RESER — observed vs trend")
lines(reser_perm, col = "#2980b9", lwd = 2)
par(mfrow = c(1, 1))
cst <- modele_dols$theta[1]
b_ctot <- modele_dols$theta[2]
b_tnt <- modele_dols$theta[3]
b_mre <- modele_dols$theta[4]
b_reser <- modele_dols$theta[5]
n_obs <- min(length(reer_clean), length(ctot_perm),
length(tnt_perm), length(mre_perm),
length(reser_perm))
reer_vec <- as.numeric(reer_clean)[1:n_obs]
ctot_vec <- as.numeric(ctot_perm)[1:n_obs]
tnt_vec <- as.numeric(tnt_perm)[1:n_obs]
mre_vec <- as.numeric(mre_perm)[1:n_obs]
reser_vec <- as.numeric(reser_perm)[1:n_obs]
dates_vec <- seq(as.Date("2004-01-01"), by = "month",
length.out = n_obs)
BEER_hp <- cst + b_ctot * ctot_vec + b_tnt * tnt_vec +
b_mre * mre_vec + b_reser * reser_vec
ECT_hp <- reer_vec - BEER_hp
misalign_hp <- ECT_hp * 100
resultats_beer_hp <- data.frame(
Date = dates_vec,
REER_Observe = reer_vec,
BEER_HP = BEER_hp,
ECT = ECT_hp,
Misalignment = misalign_hp,
Direction = ifelse(misalign_hp > 0, "Surévaluation", "Sous-évaluation")
)
comparison_df <- data.frame(
Date = dates_vec,
Misalign_noHP = as.numeric(reer_clean)[1:n_obs] -
(cst + b_ctot * as.numeric(ctot_clean)[1:n_obs] +
b_tnt * as.numeric(tnt_clean)[1:n_obs] +
b_mre * as.numeric(mre_clean)[1:n_obs] +
b_reser* as.numeric(reser_clean)[1:n_obs]),
Misalign_HP = ECT_hp
)
ggplot(comparison_df, aes(x = Date)) +
geom_line(aes(y = Misalign_noHP * 100, colour = "Sans HP"),
linewidth = 0.8, linetype = "dashed") +
geom_line(aes(y = Misalign_HP * 100, colour = "Avec HP"),
linewidth = 1.0) +
geom_hline(yintercept = 0, colour = "black", linewidth = 0.5) +
scale_colour_manual(values = c("Sans HP" = "grey60",
"Avec HP" = "#2980b9")) +
labs(title = "Mésalignement — avec vs sans HP sur les fondamentaux",
subtitle = "Coefficients DOLS | λ = 14400",
x = NULL, y = "Écart REER − BEER (log pts × 100)",
colour = NULL) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom", panel.grid.minor = element_blank())
# Stationnarité du mésalignement
print(summary(ur.df(ECT_hp, type = "none", lags = 4, selectlags = "AIC")))##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression none
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.028920 -0.002349 -0.000200 0.002081 0.047891
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.08874 0.02718 -3.266 0.001242 **
## z.diff.lag1 -0.31449 0.06264 -5.021 9.68e-07 ***
## z.diff.lag2 0.11692 0.06585 1.776 0.076987 .
## z.diff.lag3 0.22144 0.06130 3.613 0.000365 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.005431 on 255 degrees of freedom
## Multiple R-squared: 0.2029, Adjusted R-squared: 0.1904
## F-statistic: 16.22 on 4 and 255 DF, p-value: 7.492e-12
##
##
## Value of test-statistic is: -3.2655
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.58 -1.95 -1.62print(summary(ur.kpss(ECT_hp, type = "mu", lags = "short")))##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 5 lags.
##
## Value of test-statistic is: 0.1774
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739