652 lines
20 KiB
TeX
652 lines
20 KiB
TeX
\section*{Chapitre \ref{chap:methodes-lissage}}
|
||
\addcontentsline{toc}{section}{Chapitre \protect\ref{chap:methodes-lissage}}
|
||
|
||
\begin{solution}{1.1}
|
||
\begin{enumerate}
|
||
\item
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> 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)
|
||
\end{Sinput}
|
||
\end{Schunk}
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> xtable(Yt.ts,digits=1) ## Générer une table LaTeX
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2008 & & & & & & & -0.1 & 0.5 & 0.7 & 0.9 & 1.4 & 2.3 \\
|
||
2009 & 1.5 & 0.9 & 2.2 & 0.8 & 0.2 & 0.3 & 1.0 & 0.3 & 0.8 & 0.4 & 1.6 & 2.0 \\
|
||
2010 & 3.2 & 2.3 & 1.4 & 0.6 & 0.7 & 1.1 & -0.2 & 1.4 & 0.9 & 1.4 & 1.4 & 1.9 \\
|
||
2011 & 3.1 & 2.1 & 2.7 & 1.7 & 1.7 & 0.1 & 0.9 & 1.6 & 1.6 & 2.5 & 2.4 & 2.6 \\
|
||
2012 & 2.0 & 3.2 & 2.9 & 1.4 & 1.1 & 1.3 & 1.4 & 1.4 & 1.5 & 1.7 & 2.3 & 2.4 \\
|
||
2013 & 3.0 & 2.3 & 2.3 & 1.9 & 1.7 & 0.5 & 0.9 & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
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
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> xtable(Zt.ts <- diff(Yt.ts,12),digits=1)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & 1.1 & -0.2 & 0.1 & -0.5 & 0.2 & -0.3 \\
|
||
2010 & 1.7 & 1.4 & -0.8 & -0.2 & 0.6 & 0.8 & -1.2 & 1.2 & 0.1 & 1.1 & -0.2 & -0.1 \\
|
||
2011 & -0.1 & -0.2 & 1.4 & 1.0 & 1.0 & -0.9 & 1.1 & 0.2 & 0.7 & 1.1 & 1.0 & 0.8 \\
|
||
2012 & -1.1 & 1.1 & 0.1 & -0.3 & -0.6 & 1.1 & 0.5 & -0.2 & -0.1 & -0.8 & -0.1 & -0.2 \\
|
||
2013 & 1.0 & -0.9 & -0.6 & 0.5 & 0.5 & -0.8 & -0.5 & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
|
||
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é
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> xtable(Yt.ts-Zt.ts,digits=1)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & -0.1 & 0.5 & 0.7 & 0.9 & 1.4 & 2.3 \\
|
||
2010 & 1.5 & 0.9 & 2.2 & 0.8 & 0.2 & 0.3 & 1.0 & 0.3 & 0.8 & 0.4 & 1.6 & 2.0 \\
|
||
2011 & 3.2 & 2.3 & 1.4 & 0.6 & 0.7 & 1.1 & -0.2 & 1.4 & 0.9 & 1.4 & 1.4 & 1.9 \\
|
||
2012 & 3.1 & 2.1 & 2.7 & 1.7 & 1.7 & 0.1 & 0.9 & 1.6 & 1.6 & 2.5 & 2.4 & 2.6 \\
|
||
2013 & 2.0 & 3.2 & 2.9 & 1.4 & 1.1 & 1.3 & 1.4 & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
|
||
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.
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> ## Simple Moving Average(q=1)
|
||
> xtable(mt1 <- lag(SMA(Zt.ts,n=3),1),digits=2)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & & 0.32 & -0.22 & -0.06 & -0.21 & 0.54 \\
|
||
2010 & 0.92 & 0.77 & 0.15 & -0.12 & 0.39 & 0.07 & 0.26 & 0.05 & 0.78 & 0.32 & 0.22 & -0.16 \\
|
||
2011 & -0.13 & 0.36 & 0.74 & 1.12 & 0.36 & 0.37 & 0.10 & 0.63 & 0.63 & 0.90 & 0.93 & 0.20 \\
|
||
2012 & 0.23 & 0.03 & 0.32 & -0.24 & 0.10 & 0.37 & 0.51 & 0.09 & -0.37 & -0.34 & -0.37 & 0.25 \\
|
||
2013 & -0.02 & -0.16 & -0.33 & 0.16 & 0.10 & -0.26 & & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
Moyenne mobile avec $q=5$
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> ## Simple Moving Average(q=5)
|
||
> xtable(mt2 <- lag(SMA(Zt.ts,n=11),5),digits=2)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & & & & & & 0.28 \\
|
||
2010 & 0.25 & 0.17 & 0.26 & 0.32 & 0.40 & 0.40 & 0.24 & 0.10 & 0.16 & 0.30 & 0.34 & 0.36 \\
|
||
2011 & 0.37 & 0.37 & 0.37 & 0.33 & 0.45 & 0.55 & 0.63 & 0.54 & 0.52 & 0.44 & 0.32 & 0.36 \\
|
||
2012 & 0.36 & 0.40 & 0.32 & 0.22 & 0.05 & -0.02 & 0.06 & 0.06 & -0.04 & -0.07 & 0.03 & -0.02 \\
|
||
2013 & -0.14 & -0.18 & & & & & & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
Lissage exponentiel double avec $\alpha=0.75$
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> ## Double Exponential Moving Average
|
||
> xtable(mt3 <- DEMA(Zt.ts,n=1,ratio=.05),digits=2)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & 1.06 & 0.94 & 0.85 & 0.71 & 0.66 & 0.55 \\
|
||
2010 & 0.65 & 0.72 & 0.57 & 0.48 & 0.48 & 0.50 & 0.33 & 0.39 & 0.36 & 0.41 & 0.33 & 0.28 \\
|
||
2011 & 0.22 & 0.17 & 0.27 & 0.33 & 0.38 & 0.24 & 0.31 & 0.29 & 0.31 & 0.38 & 0.43 & 0.45 \\
|
||
2012 & 0.29 & 0.36 & 0.33 & 0.26 & 0.17 & 0.25 & 0.27 & 0.22 & 0.18 & 0.07 & 0.04 & 0.01 \\
|
||
2013 & 0.09 & -0.02 & -0.09 & -0.04 & 0.00 & -0.09 & -0.14 & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
Régression linéaire
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> t <- 0:48
|
||
> (lm1 <- lm(Zt.ts~t)) ## Modèle de régression sur une variable
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
Call:
|
||
lm(formula = Zt.ts ~ t)
|
||
|
||
Coefficients:
|
||
(Intercept) t
|
||
0.446924 -0.009856
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> coeff1 <- coefficients(lm1)
|
||
\end{Sinput}
|
||
\end{Schunk}
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> xtable(mt4 <- ts(coeff1[1]+t*coeff1[2],start=c(2009,7),deltat=1/12),digits=2)
|
||
\end{Sinput}
|
||
% latex table generated in R 3.6.1 by xtable 1.8-4 package
|
||
% Thu Jan 2 17:35:43 2020
|
||
\begin{table}[ht]
|
||
\centering
|
||
\begin{tabular}{rrrrrrrrrrrrr}
|
||
\hline
|
||
& Jan & Feb & Mar & Apr & May & Jun & Jul & Aug & Sep & Oct & Nov & Dec \\
|
||
\hline
|
||
2009 & & & & & & & 0.45 & 0.44 & 0.43 & 0.42 & 0.41 & 0.40 \\
|
||
2010 & 0.39 & 0.38 & 0.37 & 0.36 & 0.35 & 0.34 & 0.33 & 0.32 & 0.31 & 0.30 & 0.29 & 0.28 \\
|
||
2011 & 0.27 & 0.26 & 0.25 & 0.24 & 0.23 & 0.22 & 0.21 & 0.20 & 0.19 & 0.18 & 0.17 & 0.16 \\
|
||
2012 & 0.15 & 0.14 & 0.13 & 0.12 & 0.11 & 0.10 & 0.09 & 0.08 & 0.07 & 0.06 & 0.05 & 0.04 \\
|
||
2013 & 0.03 & 0.02 & 0.01 & 0.00 & -0.01 & -0.02 & -0.03 & & & & & \\
|
||
\hline
|
||
\end{tabular}
|
||
\end{table}\end{Schunk}
|
||
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
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> projection <- coeff1[1]+53*coeff1[2]
|
||
> saisonnalite <- mean((Yt.ts-Zt.ts)[6+12*0:3])
|
||
> (taux.inf.dec.2013 <- (projection+saisonnalite))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
(Intercept)
|
||
2.137743
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
Le taux d'inflation prejeté en décembre 2013 est 2.14\%
|
||
\item
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> depense.dec.2008 <- 674
|
||
> depense.dec.2013 <- 674*(1+taux.inf.dec.2013/100)
|
||
\end{Sinput}
|
||
\end{Schunk}
|
||
Le montant projeté des achats de cadeaux en décembre 2013 est 688.41 \$
|
||
\end{enumerate}
|
||
\end{solution}
|
||
\begin{solution}{1.2}
|
||
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{solution}
|
||
\begin{solution}{1.3}
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> 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))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.288637639 0.112996047 -0.061344651 -0.103095509
|
||
[5] -0.017497594 -0.086523113 0.005008358 -0.340978628
|
||
[9] -0.090637274
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (mu.diff.l.bbry.sel <- mean(diff.l.bbry.sel))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] -0.03260386
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (sigma.diff.l.bbry.sel <- sd(diff.l.bbry.sel))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.170735
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (prix.arbre <- S0*(ud <- exp(3*(mu.diff.l.bbry.sel+c(1,-1)*
|
||
+ sigma.diff.l.bbry.sel/(2*sqrt(3))))))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 10.996838 8.181586
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (p.rn <- (exp(rf*84/365)-ud[2])/(ud[1]-ud[2]))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.8243048
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> q.rn <- 1-p.rn
|
||
> (P0 <- sum(exp(-rf*84/365)*(c(p.rn,q.rn)*pmax(K-prix.arbre,0))))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.406084
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (BT <- P0*exp(rB*84/365))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.4096037
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (K-ST)-BT
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 1.362608
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
La valeur du paramètre $\mu$ de rendement moyen est -0.0326.
|
||
La valeur du paramètre $\sigma$ de volatilité est 0.1707.
|
||
La valeur des prix de l'arbre binomial sont 10.9968 et 8.1816.
|
||
La valeur de la probabilité neutre au risque d'une hausse est 0.8243.
|
||
La valeur de l'option est 0.4061.
|
||
Le profit, qui correspont à la différence entre la réclamation contingente de l'option et le coût d'acquisition, est de 1.3626.
|
||
\end{solution}
|
||
\begin{solution}{1.4}
|
||
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()}.
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> 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)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
A A.EMA.4 A.EMA.7 A.EMA.4 A.EMA.7
|
||
[1,] 1.2 1.200000 1.200000 0.000000000 0.0000000000
|
||
[2,] 1.5 1.320000 1.410000 0.032400000 0.0081000000
|
||
[3,] 1.4 1.352000 1.403000 0.002304000 0.0000090000
|
||
[4,] 2.1 1.651200 1.890900 0.201421440 0.0437228100
|
||
[5,] 1.8 1.710720 1.827270 0.007970918 0.0007436529
|
||
[6,] 1.9 1.786432 1.878181 0.012897691 0.0004760688
|
||
[7,] 2.2 1.951859 2.103454 0.061573857 0.0093210722
|
||
[8,] 2.4 2.131116 2.311036 0.072298864 0.0079145417
|
||
[9,] 2.0 2.078669 2.093311 0.006188861 0.0087069216
|
||
[10,] 1.9 2.007202 1.957993 0.011492180 0.0033632189
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> (A.MSE <- colMeans(A.SE)*(n.A/(n.A-1)))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
A.EMA.4 A.EMA.7
|
||
0.04539420 0.00915081
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
La valeur $\alpha=0.7$ produit une erreur quadratique moyenne inférieure.
|
||
\end{solution}
|
||
\begin{solution}{1.5}
|
||
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.
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> 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)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.006416607 0.514589803
|
||
[1] 0.003674206 0.585410197
|
||
[1] 0.002489337 0.629179607
|
||
[1] 0.001912478 0.656230590
|
||
[1] 0.001607733 0.672949017
|
||
[1] 0.001437559 0.683281573
|
||
[1] 0.001338969 0.689667444
|
||
[1] 0.00128047 0.69361413
|
||
[1] 0.001245226 0.696053315
|
||
[1] 0.001223788 0.697560814
|
||
[1] 0.001210668 0.698492500
|
||
[1] 0.001202609 0.699068314
|
||
[1] 0.001197648 0.699424186
|
||
[1] 0.001194588 0.699644128
|
||
[1] 0.0011927 0.6997801
|
||
[1] 0.001191534 0.699864069
|
||
[1] 0.001190814 0.699915990
|
||
[1] 0.00119025 0.69995669
|
||
[1] 0.00119025 0.69995669
|
||
$minimum
|
||
[1] 0.6999567
|
||
|
||
$objective
|
||
[1] 0.00119025
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
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{solution}
|
||
\begin{solution}{1.6}
|
||
On importe d'abord l'ensemble de données
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> BoA <- ts(read.csv("BoA.csv",header=TRUE,sep="\t"))
|
||
\end{Sinput}
|
||
\end{Schunk}
|
||
|
||
\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
|
||
\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:
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> (BoA.acf <- acf(BoA[,2],lag.max=19))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
Autocorrelations of series ‘BoA[, 2]’, by lag
|
||
|
||
0 1 2 3 4 5 6
|
||
1.000 0.817 0.587 0.325 0.105 -0.059 -0.161
|
||
7 8 9 10 11 12 13
|
||
-0.207 -0.272 -0.291 -0.325 -0.293 -0.249 -0.203
|
||
14 15 16 17 18 19
|
||
-0.106 -0.078 -0.057 -0.038 0.003 0.002
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> dummy <- dev.off()
|
||
\end{Sinput}
|
||
\end{Schunk}
|
||
|
||
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 20.
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> (BoA.acf.IC <- round(c(1/sqrt(20)*qnorm(0.05),-1/sqrt(20)*qnorm(0.05)),4))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] -0.3678 0.3678
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
\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[ -0.3678,0.3678 \right]
|
||
\end{align*}
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> (BoA.nbacfplus <- sum(BoA.acf$acf[-1]<BoA.acf.IC[1]) +
|
||
+ sum(BoA.acf$acf[-1]>BoA.acf.IC[2]))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 2
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
Comme 2 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})
|
||
\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.
|
||
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> BoA.chdir <- abs((9-(2/3)*18)/sqrt((16*20-29)/90))
|
||
> BoA.chdir > qnorm(0.95)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] TRUE
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
On évalue la statistique de test, qui prend la valeur 1.6684. Comme cette valeur est supérieure au seuil de 1.6449, 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.
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> Box.test(BoA[,2],lag=19,type="Box-Pierce")
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
Box-Pierce test
|
||
|
||
data: BoA[, 2]
|
||
X-squared = 33.518, df = 19, p-value = 0.02093
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> qchisq(0.9,19)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 27.20357
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
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
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> round(diff(log(BoA[,2])),4)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
Time Series:
|
||
Start = 2
|
||
End = 20
|
||
Frequency = 1
|
||
[1] 0.0000 0.0381 0.0035 -0.0090 -0.0176 0.0314
|
||
[7] -0.0104 0.0021 0.0267 -0.0074 0.0014 -0.0681
|
||
[13] -0.0537 -0.0154 -0.0133 0.0295 0.0235 0.0200
|
||
[19] -0.0313
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
\item
|
||
\begin{Schunk}
|
||
\begin{Sinput}
|
||
> (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)))
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 0.08642 0.06185 0.03017 0.02963 0.02753 0.06795
|
||
[7] 0.03257 0.03617 0.18785 0.61597 0.79813 0.71857
|
||
[13] 0.17257 0.06697 0.15075 0.12818
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> Box.test(BoA.hist.var,lag=15,type="Box-Pierce")
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
Box-Pierce test
|
||
|
||
data: BoA.hist.var
|
||
X-squared = 13.708, df = 15, p-value = 0.5478
|
||
\end{Soutput}
|
||
\begin{Sinput}
|
||
> qchisq(0.9,15)
|
||
\end{Sinput}
|
||
\begin{Soutput}
|
||
[1] 22.30713
|
||
\end{Soutput}
|
||
\end{Schunk}
|
||
|
||
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{solution}
|
||
\begin{solution}{1.7}
|
||
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{solution}
|