Saisonnalité

Les morts

Soit \(X\) le nombre de tués sur la route en France : on dispose de \(n=20\) observations.

Créer un R-objet x.ts en utilisant la commande ts(x, frequency = a, start = c(b, c)). A quoi servent les paramètres (a, b, c) ?

Tracer la série temporelle avec plot() puis observer l’évolution du nombre de décès en utilisant plot(x.ts, lag(x.ts, 1))

X = c(400,330,270,280,350,320,250,260,290,210,240,250,270,200,220,230,240,200,150,160)
x.ts = ts(X, frequency = 4, start = c(2009,1))

plot(x.ts, main = "Série temporelle du nombre de morts sur la route en France", col = 2, lwd = 2)

plot(x.ts, lag(x.ts, 1))

Tendance

1. Ecrire la modélisation de la tendance. Ecrire les équations permettant de déterminer l’équation de la droite des moindres carrées.

2. Créer une matrice M carrée avec les coefficients du membre de gauche du système en utilisant M = matrix(c(x1, x2, x3, x4), 2, 2) où x1, x2, x3, x4 sont à coder préalablement.

3. Créer un vecteur b qui contient le terme de droite du système.

4. Trouver la tendance de la série en utilisant solve(M, b)

On rappelle l’équation de la tendance : \[ T_t = a + bt \] Il faut déterminer a et b par régression linéaire : On note \[S(a,b) =\sum_{t=1}^{20}(Y_t - (a+bt))^2\]

Régression linéaire “manuelle” 

t = 1:20
reg = lm(X ~ t); reg
## 
## Call:
## lm(formula = X ~ t)
## 
## Coefficients:
## (Intercept)            t  
##     349.158       -8.872
RegLin = function(c){-8.87*c+349.16}

Ainsi il faut résoudre le système nul des dérivées premières : \[ \left \{ \begin{array}{c @{=} c} \frac {\partial S_{a,b} }{\partial a} (a,b) = 0 \\ \frac {\partial S_{a,b} }{\partial b} (a,b) = 0 \\ \end{array} \right. \]

On doit alors résoudre le système suivant :

\[ \left \{ \begin{array}{c @{=} c} 20a + (\sum_{t=1}^{20} t)b = \sum_{t=1}^{20}Y_t \\ (\sum_{t=1}^{20}t)a + (\sum_{t=1}^{20}t^2)b = \sum_{t=1}^{20} tY_t \end{array} \right. \] \(\Leftrightarrow\)

\[ \left(\begin{array}{cc} 20 & \sum_{t=1}^{20} t\\ \sum_{t=1}^{20}t & \sum_{t=1}^{20}t^2) \end{array}\right) \left(\begin{array}{cc} a\\ b \end{array}\right) = \left(\begin{array}{cc} \sum_{t=1}^{20}Y_t\\ \sum_{t=1}^{20} tY_t \end{array}\right) \] De plus on a : \[ \left(\begin{array}{cc} 20 & \sum_{t=1}^{20} t\\ \sum_{t=1}^{20}t & \sum_{t=1}^{20}t^2 \end{array}\right) = \left(\begin{array}{cc} 20 & 210\\ 210 & 2870 \end{array}\right) \] et

\[ \left(\begin{array}{cc} \sum_{t=1}^{20}Y_t\\ \sum_{t=1}^{20} tY_t \end{array}\right) = \left(\begin{array}{cc} 5120\\ 47860 \end{array}\right) \] Ainsi, après résolution du système, nous avons :

x1 = max(t)
x2 = sum(t)
x3 = sum(t)
x4 = sum(t^2)
M = matrix(c(x1,x2,x3,x4),2,2);
b = c(sum(X),sum(t*X))
solve(M,b)
## [1] 349.15789  -8.87218

qui représente alors l’ordonnée à l’origine ainsi que le coefficient directeur. On retombe sur le même résultat que nous avions obtenu avec lm.

Saison

1. Trouver la série St pour tous les t. Faire une représentation graphique avec en abscisse les trimestres T1/T2/T3/T4 et en superposant les coefficients St pour chaque année.

2. Chercher les coefficients saisonniers (combien y en a-t-il ?) et les représenter sur le graphe précédent.

3. Déduire les coefficients corrigés : que vaut la somme ?

4. Déduire la série corrigée des variations saisonnières : faire un graphe avec la série initiale, sa tendance et la série corrigée des variations saisonnières - sur le même graphe.

5. Proposer une prévision du nombre de décès cette année 2018. Quelles sont les hypothèses indispensables ?

Rappel : on propose la décomposition \(Y_t = T_t + S_t +Ut\), on a trouvé \(T_t = 349,16 - 8,87t\). On a alors : \(S_t = Y_t - T_t -U_t = Y_t - 349,16 + 8,9t - U_t\) Pour la suite on calculera comme si il n’y avait pas d’erreur \(U_t\). Il faut alors calculer : \[ \left \{ \begin{array}{c @{=} c} S_1 = Y_1 - 349.16 + 8,87\\ S_t = Y_t -349.16 + 8,87\times t \\ S_{20} = Y_{20}-349.16 + 8,87\times20 \\ \end{array} \right. \] On sait que la période ou frequency est supposée égale à 4 pour découper notre année en trimestres.

S = c(X-349 + 8.9*t)
an1 = c(S[1],S[2],S[3],S[4])
an2 =c(S[5],S[6],S[7],S[8])
an3 =c(S[9],S[10],S[11],S[12])
an4 =c(S[13],S[14],S[15],S[16])
an5 =c(S[17],S[18],S[19],S[20])
plot(an1, col = "Brown", ylab = "Morts", xlab = "Trimestre", main = "Coefficient de mortalité par trimestre", lwd = 2)
lines(an2, type = 'p', col = "Red", lwd = 2)
lines(an3, type = 'p', col = "Yellow", lwd = 2)
lines(an4, type = 'p', col = "Blue", lwd = 2)
lines(an5, type = 'p', col = "Green", lwd = 2)
legend("bottomleft", c("2009","2010","2011","2012","2013"), col = c("Brown","Red","Yellow","Blue","Green"), lwd = c(2,2,2,2,2))

Ainsi nous aurons alors 4 coefficients saisonniers

coef1 = (an1[1]+an2[1]+an3[1]+an4[1] + an5[1])/5
coef2 = (an1[2]+an2[2]+an3[2]+an4[2] + an5[2])/5
coef3 = (an1[3]+an2[3]+an3[3]+an4[3] + an5[3])/5
coef4 = (an1[4]+an2[4]+an3[4]+an4[4] + an5[4])/5
coef = c(coef1,coef2,coef3,coef4)
coef
## [1]  41.1  -8.0 -25.1  -6.2
plot(an1, col = "Brown", ylab = 'Morts', xlab = 'Trimestre', main = 'Coefficient de mortalité par trimestre', lwd = 3)
lines(an2, type = 'p', col = "Red", lwd = 2)
lines(an3, type = 'p', col = "Yellow", lwd = 2)
lines(an4, type = 'p', col = "Blue", lwd = 2)
lines(an5, type = 'p', col = "Green", lwd = 2)
lines(coef, type = 'p', col = "Black", lwd = 3)
legend("bottomleft", c("2009","2010","2011","2012","2013", "Coeff"), col = c("Brown","Red","Yellow","Blue","Green", "Black"), lwd = c(2,2,2,2,2,3))

Maintenant tentons de corriger nos coefficients pour ne pas avoir d’effet saisonnier en moyenne :

CoefCor1 = coef1 - mean(S)
CoefCor2 = coef2 - mean(S)
CoefCor3 = coef3 - mean(S)
CoefCor4 = coef4 - mean(S)
CoefCor = c(CoefCor1,CoefCor2,CoefCor3,CoefCor4)

\[ S^{corr} = \left(\begin{array}{cc} s_1^{corr} = s_1 - \bar S \\ s_2^{corr} = s_2 - \bar S\\ s_3^{corr} = s_3 - \bar S\\ s_4^{corr} = s_4 - \bar S\\ \end{array}\right) \]

Ainsi nous avons le vecteur de nos coefficients corrigés : \[ S^{corr} = \left(\begin{array}{cc} 40.65\\ -8.45\\ -25.55\\ -7.4\\ \end{array}\right) \]

Ainsi nous avons le vecteur de nos coefficients corrigés, vérifions que leur somme est nulle :

sum(CoefCor)
## [1] 2.664535e-15

Série corrigée des variations saisonnières \[ Y^{cvs} = Y_t - s^{corr}_t \]

CoefCormult = c(CoefCor,CoefCor,CoefCor,CoefCor,CoefCor)
Ycvs = X- CoefCormult
plot(X, main = "Morts sur la route en fonction du temps (indice mensuel)", type ='l',col = 2, lwd = 2, ylab = "Morts")
abline(349.16, -8.87, lwd = 2)
lines(Ycvs, col = "Blue", lwd = 2)
legend("topright", c("Série initiale", "Tendance", "Série corrigée"), col = c("Red", "Black", "Blue"), lwd = c(2,2,2))

Prédiction de mort sur l’année 2018

Supposons qu’il n’y a pas de modifications majeures sur les conditions routières \[ Y_{2018}^{prev} = Y_{t_12018}^{prev} + Y_{t_22018}^{prev} + Y_{t_32018}^{prev} + Y_{t_42018}^{prev}\\ Y_{2018}^{prev} = (349.16 - 8.87\times t_1 + s^{corr}_{1})_{t_1} + (349.16 - 8.87\times t_2 + s^{corr}_{2})_{t_2} + (349.16 - 8.87\times t_3 + s^{corr}_{3})_{t_3} + (349.16 - 8.87\times t_4 + s^{corr}_{4})_{t_4}\\ Y_{2018}^{prev} = (349.16 - 8.87\times39 + 40.65)_{t_1} + (349.16 - 8.87\times40 -8.45)_{t_2} + (349.16 - 8.87\times41 -25.55)_{t_3} + (349.16 - 8.87\times42 -6.65)_{t_4}\\ Y_{2018}^{prev} = -40.3\\ \]

prev2k181= 349.16 - 8.87*39 + CoefCor1
prev2k182= 349.16 - 8.87*40 + CoefCor2
prev2k183= 349.16 - 8.87*41 + CoefCor3
prev2k184= 349.16 - 8.87*42 + CoefCor4
prev2k18 = prev2k181 + prev2k182 + prev2k183 + prev2k184

La prévision est certainement trop éloignée afin d’avoir un résultat probable et/ou cohérent