\chapter{Méthodes de lissage et saisonnalité} \label{chap:methodes-lissage} \Opensolutionfile{reponses}[reponses-methodes-lissage] \Opensolutionfile{solutions}[solutions-methodes-lissage] \begin{Filesave}{reponses} \bigskip \section*{Réponses} \end{Filesave} \begin{Filesave}{solutions} \section*{Chapitre \ref{chap:methodes-lissage}} \addcontentsline{toc}{section}{Chapitre \protect\ref{chap:methodes-lissage}} \end{Filesave} <>= options(width = 55) @ \begin{exercice} On considère les taux d'inflation sur 12 mois disponibles dans le fichier \url{cg130823a001-fra.csv}. On représente cette série chronologique par la variable aléatoire $Y_t$. L'an passé, les Canadiens ont dépensé en moyenne $674\$$ en cadeaux au mois de décembre 2012. Notre objectif est de prévoir quel sera le montant dépensé pour l'achat de cadeaux en décembre 2013. \begin{enumerate} \item Tracez un graphique de la série chronologique $Y_t$ à l'aide d'un logiciel statistique. Êtes vous en mesure de déceler visuellement la présence d'une tendance et/ou d'une saisonnalité ? \item Utilisez l'opérateur différentiel $\nabla_{12}$ afin d'éliminer la saisonnalité annuelle de la série chronologique $Y_t$ et obtenir la série $Z_t$. Tracez à nouveau un graphique avec les données obtenues. Remarquez-vous toujours la présence de saisonnalité ? Tracez le graphique de la composante de saisonnalité $s_t$. \item Maintenant, nous voulons déceler s'il y a présence d'une tendance dans les données. En utilisant la méthode de la moyenne mobile avec $q=1$ et $q=5$, du lissage exponentiel double avec $\alpha=5\%$ et de la régression linéaire simple, estimer la tendance $\hat{m}_t$. Faire le graphique superposé des 5 tendances. \item En utilisant le résultat de la régression linéaire précédente, prévoir la valeur non saisonnalisée en décembre 2013. En évaluant la moyenne des différences entre la série $Y_t$ et la valeur de la régression pour les mois de décembre des années précédente, on peut estimer la valeur $\hat{s}_{12}$. Ajouter cette valeur au résultat obtenu pour obtenir une estimation du taux d'inflation en décembre 2013. \item En applicant ce taux d'inflation à la donnée du problème, prédire le montant dépensé pour l'achat de cadeaux en décembre 2013. \end{enumerate} \begin{sol} \begin{enumerate} \item <<>>= library(xtable) library(zoo) library(TTR) Yt <- read.csv("inflation.csv",header=TRUE,sep="\t")[,2] Yt.ts <-ts(Yt,start=c(2008,7),deltat=1/12) @ <>= xtable(Yt.ts,digits=1) ## Générer une table LaTeX @ <>= pdf("exercice1-graph1.pdf",paper="special", width=6, height=6) ## Générer le fichier PDF contenant le graphique plot(Yt.ts) dummy <- dev.off() ## Fermer le fichier PDF @ On retrouve le graphique de la série $Y_t$ à la figure \ref{fig:exercice1-graph1}. \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-graph1.pdf} \caption{Graphique de la série $Y_t$} \label{fig:exercice1-graph1} \end{figure} \item <>= xtable(Zt.ts <- diff(Yt.ts,12),digits=1) @ <>= pdf("exercice1-graph2.pdf",paper="special", width=6, height=6) plot(Zt.ts) dummy <- dev.off() @ On retrouve le graphique de la série désaisonnalisée $Z_t$ à la figure \ref{fig:exercice1-graph2}. \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-graph2.pdf} \caption{Graphique de la série désaisonnalisée $Z_t$} \label{fig:exercice1-graph2} \end{figure} On élimine la composante de saisonnalité <>= xtable(Yt.ts-Zt.ts,digits=1) @ <>= pdf("exercice1-graph3.pdf",paper="special", width=6, height=6) plot(Zt.ts-Yt.ts) dummy <- dev.off() @ On retrouve le graphique de la composante de saisonnalité $Y_t-Z_t$ à la figure \ref{fig:exercice1-graph3}. \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-graph3.pdf} \caption{Graphique de la composante de saisonnalité $Y_t-Z_t$} \label{fig:exercice1-graph3} \end{figure} \item On élimime maintenant la tendance: On utilise une moyenne mobile avec $q=1$. Comme la fonction \emph{SMA()} utilise les $2q+1$ données précédentes et que nous voulons une moyenne mobile centrée, nous devons utiliser l'opérateur de rétrodécalage $B()$ pour décaler la série. <>= ## Simple Moving Average(q=1) xtable(mt1 <- lag(SMA(Zt.ts,n=3),1),digits=2) @ Moyenne mobile avec $q=5$ <>= ## Simple Moving Average(q=5) xtable(mt2 <- lag(SMA(Zt.ts,n=11),5),digits=2) @ Lissage exponentiel double avec $\alpha=0.75$ <>= ## Double Exponential Moving Average xtable(mt3 <- DEMA(Zt.ts,n=1,ratio=.05),digits=2) @ Régression linéaire <<>>= t <- 0:48 (lm1 <- lm(Zt.ts~t)) ## Modèle de régression sur une variable coeff1 <- coefficients(lm1) @ <>= xtable(mt4 <- ts(coeff1[1]+t*coeff1[2],start=c(2009,7),deltat=1/12),digits=2) @ <>= pdf("exercice1-graph4.pdf",paper="special", width=6, height=6) plot(mt1,type="l",lty=1) lines(mt2,type="l",lty=2) lines(mt3,type="l",lty=3) lines(mt4,type="l",lty=4) dummy <- dev.off() @ On retrouve le graphique de la tendance $m_t$ à la figure \ref{fig:exercice1-graph4}. \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-graph4.pdf} \caption{Graphique de la tendance $m_t$} \label{fig:exercice1-graph4} \end{figure} \item <<>>= projection <- coeff1[1]+53*coeff1[2] saisonnalite <- mean((Yt.ts-Zt.ts)[6+12*0:3]) (taux.inf.dec.2013 <- (projection+saisonnalite)) @ Le taux d'inflation prejeté en décembre 2013 est \Sexpr{round(taux.inf.dec.2013,2)}\% \item <<>>= depense.dec.2008 <- 674 depense.dec.2013 <- 674*(1+taux.inf.dec.2013/100) @ Le montant projeté des achats de cadeaux en décembre 2013 est \Sexpr{round(depense.dec.2013,2)} \$ \end{enumerate} \end{sol} \end{exercice} \begin{exercice} On a estimé la tendance d’un ensemble de données d’incendie pour une année. Cependant, suite à un problème informatique, certaines données sont manquantes. Identifiez ces données.\\ \begin{tabular}{|l|l|l|l|} \hline \multicolumn{1}{|l|}{Mois} & \multicolumn{1}{l|}{Incendies} & \multicolumn{1}{l|}{Moyenne Mobile} & \\ \hline 1 & 4 & \multicolumn{1}{l|}{-} & \\ \hline 2 & 3 & \multicolumn{1}{l|}{-} & \\ \hline 3 & \multicolumn{1}{l|}{a} & 4,8 & \\ \hline 4 & \multicolumn{1}{l|}{b} & 4,8 & \\ \hline 5 & 2 & 5,4 & \\ \hline 6 & 4 & 5,2 & \\ \hline 7 & 6 & 3,6 & \\ \hline 8 & \multicolumn{1}{l|}{c} & 3,6 & \\ \hline 9 & \multicolumn{1}{l|}{0} & 4,4 & \\ \hline 10 & 2 & 3,8 & \\ \hline 11 & 8 & \multicolumn{1}{l|}{-} & \\ \hline 12 & 3 & \multicolumn{1}{l|}{-} & \\ \hline \end{tabular} \begin{sol} On remarque d'abord que $q=2$. On peut ensuite poser les équations suivantes: \begin{align} \label{eq:1} 4+3+a+b+2 &= 24\\ b+2+4+6+c &= 26\\ c+0+2+8+3 &= 19 \end{align} En résolvant, on obtient la solution.\\ \textbf{Solution:}\\ \begin{tabular}{|l|l|l|} \hline \multicolumn{1}{|l|}{Mois} & \multicolumn{1}{l|}{Incendies} & \multicolumn{1}{l|}{Moyenne Mobile} \\ \hline 1 & 4 & \multicolumn{1}{l|}{-} \\ \hline 2 & 3 & \multicolumn{1}{l|}{-} \\ \hline 3 & \textbf{7} & 4,8 \\ \hline 4 & \textbf{8} & 4,8 \\ \hline 5 & 2 & 5,4 \\ \hline 6 & 4 & 5,2 \\ \hline 7 & 6 & 3,6 \\ \hline 8 & \textbf{6} & 3,6 \\ \hline 9 & 0 & 4,4 \\ \hline 10 & 2 & 3,8 \\ \hline 11 & 8 & \multicolumn{1}{l|}{-} \\ \hline 12 & 3 & \multicolumn{1}{l|}{-} \\ \hline \end{tabular} \end{sol} \end{exercice} \begin{exercice} Nous sommes le 28 juin 2013, à l'heure de la fermeture des marchés financiers. Vous possédez un titre de la compagnie BlackBerry dont la valeur est de $S_0 = 10.46$. Un analyste vous suggère d'acheter une option de vente européenne d'échéance de 84 jours ($t=84/365$) avec un prix d'exercice équivalant à la valeur nominale d'un contrat à terme de même échéance afin de couvrir le risque de baisse de la valeur de ce titre. On considère des rendements sur une période de 28 jours et un taux sans risque composé continument de $r=1.75\%$. En utilisant les logarithmes des valeurs historique à la fermeture du titre disponibles dans le fichier \url{blackberry.csv}, ainsi que la méthode de différenciation, évaluez les rendements mensuels du titre, qui correspondent aux résidus de ce processus différentié. Ensuite, en évaluant la moyenne et l'écart-type de cette composante, il est possible d'estimer la tendance linéaire $\mu$ et la volatilité $\sigma$ mensuelles de la série des rendements. En supposant que le prix peut prendre deux valeurs à l'échéance, soit $S_0u = S_0 e^{3(\mu+\sigma/(2\sqrt{3}))}$ et $S_0d = S_0 e^{3(\mu-\sigma/(2\sqrt{3}))}$, évaluez le prix de l'option de vente en utilisant la probabilité neutre au risque d'une hausse $p^{*} = \frac{e^{rt}-d}{u-d}$ et évaluez le profit que vous effectuerez en exercant l'option de vente le 20 septembre 2013, considérant que vous empruntez au taux $r+2\%$ pour acheter l'option. \begin{sol} <<>>= rf <- 0.0175 rB <- rf+0.02 S0 <- 10.46 ST <- 8.73 K <- S0*exp(rf*84/365) bbry <- read.csv("blackberry.csv",header=TRUE,sep=";") bbry.sel <- bbry[as.POSIXlt(bbry$Date)$wday==5,][1+3:12*4,]$Close l.bbry.sel <- log(bbry.sel) (diff.l.bbry.sel <- diff(l.bbry.sel)) (mu.diff.l.bbry.sel <- mean(diff.l.bbry.sel)) (sigma.diff.l.bbry.sel <- sd(diff.l.bbry.sel)) (prix.arbre <- S0*(ud <- exp(3*(mu.diff.l.bbry.sel+c(1,-1)* sigma.diff.l.bbry.sel/(2*sqrt(3)))))) (p.rn <- (exp(rf*84/365)-ud[2])/(ud[1]-ud[2])) q.rn <- 1-p.rn (P0 <- sum(exp(-rf*84/365)*(c(p.rn,q.rn)*pmax(K-prix.arbre,0)))) (BT <- P0*exp(rB*84/365)) (K-ST)-BT @ La valeur du paramètre $\mu$ de rendement moyen est \Sexpr{round(mu.diff.l.bbry.sel,digits=4)}. La valeur du paramètre $\sigma$ de volatilité est \Sexpr{round(sigma.diff.l.bbry.sel,digits=4)}. La valeur des prix de l'arbre binomial sont \Sexpr{round(prix.arbre[1],digits=4)} et \Sexpr{round(prix.arbre[2],digits=4)}. La valeur de la probabilité neutre au risque d'une hausse est \Sexpr{round(p.rn,digits=4)}. La valeur de l'option est \Sexpr{round(P0,digits=4)}. Le profit, qui correspont à la différence entre la réclamation contingente de l'option et le coût d'acquisition, est de \Sexpr{round((K-ST)-BT,digits=4)}. \end{sol} \end{exercice} \begin{exercice} On considère un ensemble de 10 observations: \[ \mathcal{A}=\left\{1.2,1.5,1.4,2.1,1.8,1.9,2.2,2.4,2.0,1.9 \right\} \] En utilisant une méthode de lissage exponentiel avec $\alpha=0.4$ et $\alpha=0.7$, déterminez laquelle des méthodes produit la moins grande erreur quadratique moyenne (MSE). \begin{sol} On calcule d'abord les deux séries lissées \\ \begin{tabular}{|l|r|r|} \hline \multicolumn{1}{|c|}{$\mathcal{A}$} & $\alpha=0,4$ & $\alpha=0,7$ \\ \hline 1,2 & 1,2000 & 1,2000 \\ \hline 1,5 & 1,3200 & 1,4100 \\ \hline 1,4 & 1,3520 & 1,4030 \\ \hline 2,1 & 1,6512 & 1,8909 \\ \hline 1,8 & 1,7107 & 1,8273 \\ \hline 1,9 & 1,7864 & 1,8782 \\ \hline 2,2 & 1,9519 & 2,1035 \\ \hline 2,4 & 2,1311 & 2,3110 \\ \hline 2,0 & 2,0787 & 2,0933 \\ \hline 1,9 & 2,0072 & 1,9580 \\ \hline \end{tabular} \\ On évalue ensuite l'erreur quadratique pour chaque terme \\ \begin{tabular}{|l|r|r|} \hline \multicolumn{1}{|c|}{$\mathcal{A}$} & \multicolumn{1}{l|}{$SE(\alpha=0,4)$} & \multicolumn{1}{l|}{$SE(\alpha=0,7)$} \\ \hline 1,2 & \multicolumn{1}{l|}{} & \multicolumn{1}{l|}{} \\ \hline 1,5 & 0,0324 & 0,0081 \\ \hline 1,4 & 0,0023 & 0,0000 \\ \hline 2,1 & 0,2014 & 0,0437 \\ \hline 1,8 & 0,0080 & 0,0007 \\ \hline 1,9 & 0,0129 & 0,0005 \\ \hline 2,2 & 0,0616 & 0,0093 \\ \hline 2,4 & 0,0723 & 0,0079 \\ \hline 2,0 & 0,0062 & 0,0087 \\ \hline 1,9 & 0,0115 & 0,0034 \\ \hline \end{tabular} \\ On obtient enfin l'erreur quadratique moyenne\\ \begin{tabular}{|l|l|l|} \hline & $\alpha=0,4$ & $\alpha=0,7$ \\ \hline MSE & \multicolumn{1}{r|}{0,0454} & \multicolumn{1}{r|}{0,0092} \\ \hline \end{tabular} \\ Les calculs effectués se trouvent dans le fichier \url{Lissage.Exponentiel.I.ods} \footnote{Ce fichier est au format OpenDocument et s'ouvre avec la plupart des suites bureautiques}. Avec R, on obtient les résultats suivants en utilisant la fonction de lissage exponentiel \emph{EMA()}. <<>>= A <- c(1.2, 1.5, 1.4, 2.1, 1.8, 1.9, 2.2, 2.4, 2.0, 1.9) n.A <- length(A) A.EMA.4 <- EMA(A,n=1,ratio=0.4) A.EMA.7 <- EMA(A,n=1,ratio=0.7) A.SE <- (A-cbind(A.EMA.4,A.EMA.7))^2 cbind(A,A.EMA.4,A.EMA.7,A.SE) (A.MSE <- colMeans(A.SE)*(n.A/(n.A-1))) @ La valeur $\alpha=0.7$ produit une erreur quadratique moyenne inférieure. \end{sol} \end{exercice} \begin{exercice} En utilisant les données du problème précédent, déterminez, à l'aide d'un algorithme informatique, la valeur de $\alpha$ comprise entre $0.4$ et $0.7$ qui minimise l'erreur quadratique moyenne (MSE) pour un lissage exponentiel double. \begin{sol} Une solution assez simple est d'utiliser le solveur intégré au logiciel tableau que vous utilisez et d'optimiser la valeur de la cellule contenant $\alpha$ avec comme critère de minimisation la cellule contenant l'erreur quadratique moyenne (MSE). On peut aussi construire une fonction d'optimisation dans R qui réplique le comportement du chiffrier que nous avons construit dans le logiciel tableur. <<>>= funOptAlphaDEMA <- function(alpha,data) { data.n <- length(data) data.DEMA <- DEMA(A,n=1,ratio=alpha) data.SE <- (data-data.DEMA)^2 data.MSE <- mean(data.SE)*data.n/(data.n-1) print(c(data.MSE,alpha)) data.MSE } optimize(funOptAlphaDEMA,c(0.4,0.7),A) @ Tout comme pour le lissage exponentiel effectué à la question précédente, la valeur $\alpha=0.7$ produit une erreur quadratique moyenne inférieure. \end{sol} \end{exercice} \begin{exercice} On considère les 20 observations de la valeur ajustée à la fermeture (valeur qui tient compte des dividendes) du titre de la Bank of America pour chaque lundi entre le 20 mai 2013 et le 30 septembre 2013. Ces données se trouvent dans le fichier \url{BoA.csv}. \begin{enumerate} \item En utilisant le test du corrélogramme avec un seuil de tolérance de $\alpha = 10\%$, déterminez s'il s'agit d'une série stationnaire (Bruit blanc). \item En utilisant le test du changement de direction avec un seuil de tolérance de $\alpha = 10\%$, déterminez s'il s'agit d'une série stationnaire. \item En utilisant le test de Portmanteau avec un seuil de tolérance de $\alpha = 10\%$, déterminez s'il s'agit d'une série stationnaire. \item Est-ce que ces tests sont équivalents ? Commentez. \item En utilisant la différenciation et le logarithme des données, évaluez la série des rendements hebdomadaires. \item En utilisant le même principe que pour la moyenne mobile, évaluez la variance mobile de la série précédente avec $q=2$. Que remarquez-vous ? Peut-on affirmer que c'est une série stationnaire à l'aide du test de Portmanteau avec un seuil de tolérance de $\alpha = 10\%$? \end{enumerate} \begin{sol} On importe d'abord l'ensemble de données <<>>= BoA <- ts(read.csv("BoA.csv",header=TRUE,sep="\t")) @ \begin{enumerate} \item On trace ensuite le corrélogramme (figure \ref{fig:exercice1.6-graph1}) La fonction \emph{acf} nous permet d'afficher un corrélogramme <>= pdf("exercice1-6-graph1.pdf",paper="special", width=6,height=6) acf(BoA[,2],lag.max=19) dummy <- dev.off() @ \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-6-graph1} \caption{Corrélogramme de la série BoA} \label{fig:exercice1.6-graph1} \end{figure} La fonction d'autocorrélation empirique $\hat{\rho}$ prend les valeurs suivantes: <<>>= (BoA.acf <- acf(BoA[,2],lag.max=19)) dummy <- dev.off() @ En utilisant la méthode vue dans le cours, on construit un intervalle de confiance au niveau $1-\alpha=0.9$ à partir de la distribution normale. La valeur de $n$ est \Sexpr{length(BoA[,2])}. <<>>= (BoA.acf.IC <- round(c(1/sqrt(20)*qnorm(0.05),-1/sqrt(20)*qnorm(0.05)),4)) @ \begin{align*} IC &= \frac{1}{\sqrt{n}}\left[-z_{\alpha / 2},z_{\alpha / 2} \right] \\ &= \frac{1}{\sqrt{20}}\left[-z_{0.05},z_{0.05} \right] \\ &= \left[ \Sexpr{BoA.acf.IC[1]},\Sexpr{BoA.acf.IC[2]} \right] \end{align*} <<>>= (BoA.nbacfplus <- sum(BoA.acf$acf[-1]BoA.acf.IC[2])) @ Comme \Sexpr{BoA.nbacfplus} valeurs sur 20, soit 10\% de celles-ci, sont à l'extérieur de l'intervalle de confiance, alors on ne peut rejeter l'hypothèse selon laquelle la série est stationnaire lorsqu'on se base sur le test du corrélogramme. \item Ici, on n'a qu'à tracer la série et compter les changements de direction (figure \ref{fig:exercice1.6-graph2}) <>= pdf("exercice1-6-graph2.pdf",paper="special", width=6,height=6) plot(BoA[,2]) dummy <- dev.off() @ \begin{figure}[!ht] \centering \includegraphics[height=4in, width=4in]{exercice1-6-graph2} \caption{Corrélogramme de la série BoA} \label{fig:exercice1.6-graph2} \end{figure} On en dénombre 9. <<>>= BoA.chdir <- abs((9-(2/3)*18)/sqrt((16*20-29)/90)) BoA.chdir > qnorm(0.95) @ On évalue la statistique de test, qui prend la valeur \Sexpr{round(BoA.chdir,4)}. Comme cette valeur est supérieure au seuil de \Sexpr{round(qnorm(0.95),4)}, on rejette l'hypothèse de stationnarité avec le test du changement de direction. \item Il existe deux tests de type Portmanteau. Celui que vous avez vu en classe est le test de Box-Pierce où h commence à 1. <<>>= Box.test(BoA[,2],lag=19,type="Box-Pierce") qchisq(0.9,19) @ On rejette l'hypothèse de stationnarité car la valeur de $Q^{*}=33.5182$ est supérieure au quantile $\chi^2_{0.1}(19) = 27.20357$ \item Les tests sont indépendants, différents entre eux et ne sont pas équivalents car leurs statistiques ne suivent pas la même distribution asymptotique. \item <<>>= round(diff(log(BoA[,2])),4) @ \item <<>>= (BoA.hist.var <- zoo::na.trim(apply(cbind(BoA[,2], lag(BoA[,2],1), lag(BoA[,2],2), lag(BoA[,2],3), lag(BoA[,2],4)), 1, var))) Box.test(BoA.hist.var,lag=15,type="Box-Pierce") qchisq(0.9,15) @ On remarque que la série des volatilités historiques avec $q=2$ est stationnaire bien que la volatilité ne soit pas constante. \end{enumerate} \end{sol} \end{exercice} \begin{exercice} Une série présentant une racine unitaire se présente sous la forme $Y_t = Y_{t-1}+\epsilon_t$. Quelle est la différence entre la variance du $5^e$ terme et du $7^e$ terme de cette série si $\epsilon_t \sim N(0, 0.1t^2)$? \begin{sol} La variance du $t^e$ terme est équivalente à la somme de la variance des $t$ premiers termes d'erreurs. La différence entre les variances des $5^e$ terme et du $7^e$ terme est donc égale à la somme: \begin{align*} \label{eq:2} V\left[\epsilon_6\right]+V\left[\epsilon_7\right] &= 0.1(6^2+7^2) \\ & = 8.5 \end{align*} \end{sol} \end{exercice} \Closesolutionfile{solutions} \Closesolutionfile{reponses} %%% Local Variables: %%% mode: latex %%% TeX-master: t %%% End: