# Fin de session !

La session d’hiver est enfin terminée (pour les cours en tous cas). L’examen du cours ACT6420 méthodes de prévisions est maintenant en ligne, avec l’énoncé, les annexes (qui correspondent à celles mises en ligne en début de semaine, avec quelques nombres entourés, qu’il fallait commenter expliquer) et quelques éléments (succincts) de correction (qui seront en ligne à partir de 15 heures).

Il reste encore le deuxième devoir à rendre, pour vendredi prochain dernier délai (comme indiqué mardi, après le cours). Merci aux étudiants qui ont joué le jeu, et qui ont mis une prévision de leur propre note.

# Bounding sums of random variables, part 2

It is possible to go further, much more actually, on bounding sums of random variables (mentioned in the previous post). For instance, if everything has been defined, in that previous post, on distributions on $\mathbb{R}^+$, it is possible to extend bounds of distributions on $\mathbb{R}$. Especially if we deal with quantiles. Everything we’ve seen remain valid. Consider for instance two $\mathcal{N}(0,1)$ distributions. Using the previous code, it is possible to compute bounds for the quantiles of the sum of two Gaussian variates. And one has to remember that those bounds are sharp.

> Finv=function(u) qnorm(u,0,1)
> Ginv=function(u) qnorm(u,0,1)
> n=1000
> Qinf=Qsup=rep(NA,n-1)
> for(i in 1:(n-1)){
+ J=0:i
+ Qinf[i]=max(Finv(J/n)+Ginv((i-J)/n))
+ J=(i-1):(n-1)
+ Qsup[i]=min(Finv((J+1)/n)+Ginv((i-1-J+n)/n))
+ }

Actually, it is possible to compare here with two simple cases: the independent case, where the sum has a $\mathcal{N}(0,2)$ distribution, and the comonotonic case where the sum has a $\mathcal{N}(0,2^2)$ distribution.

>  lines(x,qnorm(x,sd=sqrt(2)),col="blue",lty=2)
>  lines(x,qnorm(x,sd=2),col="blue",lwd=2)

On the graph below, the comonotonic case (usually considered as the worst case scenario) is the plain blue line (with here an animation to illustrate the convergence of the numerical algorithm)

Below that (strong) blue line, then risks are sub-additive for the Value-at-Risk, i.e.

$H^{-1}(u)\leq F^{-1}(u)+G^{-1}(u)$

but above, risks are super-additive for the Value-at-RIsk. i.e.

$H^{-1}(u)\geq F^{-1}(u)+G^{-1}(u)$

(since for comonotonic variates, the quantile of the sum is the sum of quantiles). It is possible to visualize those two cases above, in green the area where risks are super-additive, while the yellow area is where risks are sub-additive.

Recall that with a Gaussian random vector, with correlation $r$ then the quantile is the quantile of a random variable centered, with variance $2(1+r)$. Thus, on the graph below, we can visualize case that can be obtained with this Gaussian copula. Here the yellow area can be obtained with a Gaussian copulas, the upper and the lower bounds being respectively the comonotonic and the countermononic cases.

But the green area can also be obtained when we sum two Gaussian variables ! We just have to go outside the Gaussian world, and consider another copula.

Another point is that, in the previous post, $C^-$ was the lower Fréchet-Hoeffding bound on the set of copulas. But all the previous results remain valid if $C^-$ is alower bound on the set of copulas of interest. Especially

$\tau_{C^-,L}(F,G)\leq \sigma_{C,L}(F,G)\leq\rho_{C^-,L}(F,G)$

for all $C$ such that $C\geq C^-$. For instance, if we assume that the copula should have positive dependence, i.e. $C\geq C^\perp$, then

$\tau_{C^\perp,L}(F,G)\leq \sigma_{C,L}(F,G)\leq\rho_{C^\perp,L}(F,G)$

Which means we should have sharper bounds. Numerically, it is possible to compute those sharper bounds for quantiles. The lower bound becomes

$\sup_{u\in[x,1]}\left\{F^{-1}(u)+G^{-1}\left(\frac{x}{u}\right)\right\}$

while the upper bound is

$\sup_{u\in[0,x]}\left\{F^{-1}(u)+G^{-1}\left(\frac{x-u}{1-u}\right)\right\}$

Again, one can easily compute those quantities on a grid of the unit interval,

> Qinfind=Qsupind=rep(NA,n-1)
> for(i in 1:(n-1)){
+  J=1:(i)
+  Qinfind[i]=max(Finv(J/n)+Ginv((i-J)/n/(1-J/n)))
+  J=(i):(n-1)
+  Qsupind[i]=min(Finv(J/n)+Ginv(i/J))
+ }

We get the graph below (the blue area is here to illustrate how sharper those bounds get with the assumption that we do have positive dependence, this area been attained only with copulas exhibiting non-positive dependence)

For high quantiles, the upper bound is rather close to the one we had before, since worst case are probably obtained when we do have positive correlation. But it will strongly impact the lower bound. For instance, it becomes now impossible to have a negative quantile, when the probability exceeds 75% if we do have positive dependence…

> Qinfind[u==.75]
[1] 0

# Bounding sums of random variables, part 1

For the last course MAT8886 of this (long) winter session, on copulas (and extremes), we will discuss risk aggregation. The course will be mainly on the problem of bounding  the distribution (or some risk measure, say the Value-at-Risk) for two random variables with given marginal distribution. For instance, we have two Gaussian risks. What could be be worst-case scenario for the 99% quantile of the sum ? Note that I mention implications in terms of risk management, but of course, those questions are extremely important in terms of statistical inference, see e.g. Fan & Park (2006).

This problem, is sometimes related to some question asked by Kolmogorov almost one hundred years ago, as mentioned in Makarov (1981). One year after, Rüschendorf (1982) also suggested a proof of bounds calculation. Here, we focus in dimension 2. As usual, it is the simple case. But as mentioned recently, in Kreinovich & Ferson (2005), in dimension 3 (or higher), “computing the best-possible bounds for arbitrary n is an NP-hard (computationally intractable) problem“. So let us focus on the case where we sum (only) two random variable (for those interested in higher dimension, Puccetti & Rüschendorf (2012) provided interesting results for a dual version of those optimal bounds).

Let $\Delta$ denote the set of univariate continuous distribution function, left-continuous, on $\mathbb{R}$. And $\Delta^+$ the set of distributions on $\mathbb{R}^+$. Thus, $F\in\Delta^+$ if $F\in\Delta$ and $F(0)=0$. Consider now two distributions $F,G\in\Delta^+$. In a very general setting, it is possible to consider operators on $\Delta^+\times \Delta^+$. Thus, let $T:[0,1]\times[0,1]\rightarrow[0,1]$ denote an operator, increasing in each component, thus that $T(1,1)=1$. And consider some function $L:\mathbb{R}^+\times\mathbb{R}^+\rightarrow\mathbb{R}^+$ assumed to be also increasing in each component (and continuous). For such functions $T$ and $L$, define the following (general) operator, $\tau_{T,L}(F,G)$ as

$\tau_{T,L}(F,G)(x)=\sup_{L(u,v)=x}\{T(F(u),G(v))\}$

One interesting case can be obtained when $T$is a copula, $C$. In that case,

$\tau_{C,L}(F,G):\Delta^+\times\Delta^+\rightarrow\Delta^+$

and further, it is possible to write

$\tau_{C,L}(F,G)(x)=\sup_{(u,v)\in L^{-1}(x)}\{C(F(u),G(v))\}$

It is also possible to consider other (general) operators, e.g. based on the sum

$\sigma_{C,L}(F,G)(x)=\int_{(u,v)\in L^{-1}(x)} dC(F(u),G(v))$

or on the minimum,

$\rho_{C,L}(F,G)(x)=\inf_{(u,v)\in L^{-1}(x)}\{C^\star(F(u),G(v))\}$

where $C^\star$ is the survival copula associated with $C$, i.e. $C^\star(u,v)=u+v-C(u,v)$. Note that those operators can be used to define distribution functions, i.e.

$\sigma_{C,L}(F,G):\Delta^+\times\Delta^+\rightarrow\Delta^+$

and similarly

$\rho_{C,L}(F,G):\Delta^+\times\Delta^+\rightarrow\Delta^+$

All that seems too theoretical ? An application can be the case of the sum, i.e. $L(x,y)=x+y$, in that case $\sigma_{C,+}(F,G)$ is the distribution of sum of two random variables with marginal distributions $F$ and $G$, and copula $C$. Thus, $\sigma_{C^\perp,+}(F,G)$ is simply the convolution of two distributions,

$\sigma_{C^\perp,+}(F,G)(x)=\int_{u+v=x} dC^\perp(F(u),G(v))$

The important result (that can be found in Chapter 7, in Schweizer and Sklar (1983)) is that given an operator $L$, then, for any copula $C$, one can find a lower bound for $\sigma_{C,L}(F,G)$

$\tau_{C^-,L}(F,G)\leq \tau_{C,L}(F,G)\leq\sigma_{C,L}(F,G)$

as well as an upper bound

$\sigma_{C,L}(F,G)\leq \rho_{C,L}(F,G)\leq\rho_{C^-,L}(F,G)$

Those inequalities come from the fact that for all copula $C$, $C\geq C^-$, where $C^-$ is a copula. Since this function is not copula in higher dimension, one can easily imagine that get those bounds in higher dimension will be much more complicated…

In the case of the sum of two random variables, with marginal distributions $F$ and $G$, bounds for the distribution of the sum $H(x)=\mathbb{P}(X+Y\leq x)$, where $X\sim F$ and $Y\sim G$, can be written

$H^-(x)=\tau_{C^- ,+}(F,G)(x)=\sup_{u+v=x}\{ \max\{F(u)+G(v)-1,0\} \}$

for the lower bound, and

$H^+(x)=\rho_{C^- ,+}(F,G)(x)=\inf_{u+v=x}\{ \min\{F(u)+G(v),1\} \}$

for the upper bound. And those bounds are sharp, in the sense that, for all $t\in(0,1)$, there is a copula $C_t$ such that

$\tau_{C_t,+}(F,G)(x)=\tau_{C^- ,+}(F,G)(x)=t$

and there is (another) copula $C_t$ such that

$\sigma_{C_t,+}(F,G)(x)=\tau_{C^- ,+}(F,G)(x)=t$

Thus, using those results, it is possible to bound cumulative distribution function. But actually, all that can be done also on quantiles (see Frank, Nelsen & Schweizer (1987)). For all $F\in\Delta^+$ let $F^{-1}$ denotes its generalized inverse, left continuous, and let $\nabla^+$ denote the set of those quantile functions. Define then the dual versions of our operators,

$\tau^{-1}_{T,L}(F^{-1},G^{-1})(x)=\inf_{(u,v)\in T^{-1}(x)}\{L(F^{-1}(u),G^{-1}(v))\}$

and

$\rho^{-1}_{T,L}(F^{-1},G^{-1})(x)=\sup_{(u,v)\in T^\star^{-1}(x)}\{L(F^{-1}(u),G^{-1}(v))\}$

Those definitions are really dual versions of the previous ones, in the sense that $\tau^{-1}_{T,L}(F^{-1},G^{-1})=[\tau_{T,L}(F,G)]^{-1}$ and $\rho^{-1}_{T,L}(F^{-1},G^{-1})=[\rho_{T,L}(F,G)]^{-1}$.

Note that if we focus on sums of bivariate distributions, the lower bound for the quantile of the sum is

$\tau^{-1}_{C^{-},+}(F^{-1},G^{-1})(x)=\inf_{\max\{u+v-1,0\}=x}\{F^{-1}(u)+G^{-1}(v)\}$

while the upper bound is

$\rho^{-1}_{C^{-},+}(F^{-1},G^{-1})(x)=\sup_{\min\{u+v,1\}=x}\{F^{-1}(u)+G^{-1}(v)\}$

A great thing is that it should not be too difficult to compute numerically those quantities. Perhaps a little bit more for cumulative distribution functions, since they are not defined on a bounded support. But still, if the goal is to plot those bounds on $[0,10]$, for instance. The code is the following, for the sum of two lognormal distributions $LN(0,1)$.

> F=function(x) plnorm(x,0,1)
> G=function(x) plnorm(x,0,1)
> n=100
> X=seq(0,10,by=.05)
> Hinf=Hsup=rep(NA,length(X))
> for(i in 1:length(X)){
+ x=X[i]
+ U=seq(0,x,by=1/n); V=x-U
+ Hinf[i]=max(pmax(F(U)+G(V)-1,0))
+ Hsup[i]=min(pmin(F(U)+G(V),1))}

If we plot those bounds, we obtain

> plot(X,Hinf,ylim=c(0,1),type="s",col="red")
> lines(X,Hsup,type="s",col="red")

But somehow, it is even more simple to work with quantiles since they are defined on a finite support. Quantiles are here

> Finv=function(u) qlnorm(u,0,1)
> Ginv=function(u) qlnorm(u,0,1)

The idea will be to consider a discretized version of the unit interval as discussed in Williamson (1989), in a much more general setting. Again the idea is to compute, for instance

$\sup_{u\in[0,x]}\{F^{-1}(u)+G^{-1}(x-u)\}$

The idea is to consider $x=i/n$ and $u=j/n$, and the bound for the quantile function at point $i/n$ is then

$\sup_{j\in\{0,1,\cdots,i\}}\left\{F^{-1}\left(\frac{j}{n}\right)+G^{-1}\left(\frac{i-j}{n}\right)\right\}$

The code to compute those bounds, for a given $n$ is here

> n=1000
> Qinf=Qsup=rep(NA,n-1)
> for(i in 1:(n-1)){
+ J=0:i
+ Qinf[i]=max(Finv(J/n)+Ginv((i-J)/n))
+ J=(i-1):(n-1)
+ Qsup[i]=min(Finv((J+1)/n)+Ginv((i-1-J+n)/n))
+ }

Here we have (several $n$s were considered, so that we can visualize the convergence of that numerical algorithm),

Here, we have a simple code to visualize bounds for quantiles for the sum of two risks. But it is possible to go further…

# Prévision des vente de voitures au Québec

Après discussion, la date limite pour me renvoyer le second devoir est fixée à vendredi 5 octobre midi, par courriel. Je veux un fichier pdf par équipe, avec une page de garde indiquant le nom des membres du groupe, et le mot clé retenu.

Maintenant, je vais en profiter pour mettre en ligne le code tapé de matin, en cours. On avait travaillé sur la modélisation de la série des ventesde voiture, au Québec. La série est en ligne,

X=read.table(
"http://freakonometrics.blog.free.fr/public/
data/car-sales-quebec.csv",
Xt=ts(X[,2],start=c(1960,1),frequency=12)

On peut regarder l’évolution de cette série temporelles (car les dessins, et la visualisation, c’est important),

plot(Xt)

On note une tendance linéaire (ou qu’on pourrait supposer linéaire), que l’on va estimer,

X=as.numeric(Xt)
temps=1:length(X)
base=data.frame(temps,X)
reg=lm(X~temps)

et que l’on pourra représenter

plot(temps,X,type="l",xlim=c(0,120))
abline(reg,col="red")

Si on veut une série stationnaire (et c’est effectivement ce que l’on cherche), on va retrancher cette tendance à notre série, et travailler sur la série résiduelle.

La série résiduelle est ici

Y=X-predict(reg)
plot(temps,Y,type="l")

que l’on devrait pouvoir supposer stationnaire. Classiquement, on regarde les autocorrélations,

acf(Y,36,lwd=4)

où on repère un beau cycle annuel, mais on va surtout utiliser les autocorrélations partielles pour identifier l’ordre de la composante autorégressive.

pacf(Y,36,lwd=4)

La 12ème est non-nulle, et tous les autres ensuite sont significativement nulles (ou presque). On va donc tenter un $AR(12)$.

> fit.ar12=arima(Y,order=c(12,0,0))
> fit.ar12
Series: Y
ARIMA(12,0,0) with non-zero mean

Coefficients:
ar1     ar2      ar3      ar4     ar5      ar6     ar7
0.1975  0.0832  -0.1062  -0.1212  0.1437  -0.1051  0.0319
s.e.  0.0838  0.0809   0.0826   0.0843  0.0850   0.0833  0.0854
ar9     ar10    ar11    ar12  intercept
-0.0332  -0.0616  0.2635  0.4913  -148.3180
s.e.   0.0853   0.0840  0.0840  0.0841   384.5095

sigma^2 estimated as 2177974:  log likelihood=-946.75
AIC=1921.51   AICc=1926.03   BIC=1959.06

La douzième composante $\phi_{12}$ semble significative, si on repense au test de Student,

u=seq(-6,6,by=.1)
plot(u,dnorm(u),type="l")
points(0.4913/0.0841,0,pch=19,col="red")

En revanche, la huitième $\phi_{8}$ ne l’est pas

points(-0.1018/0.0847,0,pch=19,col="blue")

(voilà pour le petit retour sur la lecture des tests). Vérifions maintenant que le bruit résiduel est bien blanc… Si on regarde les autocorrélations

acf(residuals(fit.ar12),36,lwd=4)

Mais ce n’est pas un test de bruit blanc. En particulier, si une autocorrélation semblerait significative, on pourrait accepter que – globalement – les autocorrélations soient très proches de 0. On va alors faire des tests de Box-Pierce

> Box.test(residuals(fit.ar12),lag=12,
+  type='Box-Pierce')

Box-Pierce test

data:  residuals(fit.ar12)
X-squared = 7.7883, df = 12, p-value = 0.8014

Pour l’interpétation du test, c’est toujours pareil: on a une statistique de l’ordre de 7, et la loi sous-jacente (la somme des carrés des 12 premières autocorrélations du bruit) est une loi du chi-deux, à 12 degrés de liberté,

u=seq(0,30,by=.1)
plot(u,dchisq(u,df=12),type="l")
points(7.7883,0,pch=19,
col="red")

On accepte l’hypothèse que les 12 premières autocorrélations soient nulles. Si on va un peu plus loin,

> Box.test(residuals(fit.ar12),lag=18,
+  type='Box-Pierce')

Box-Pierce test

data:  residuals(fit.ar12)
X-squared = 20.3861, df = 18, p-value = 0.3115

on a la même conclusion,

Pour rappels, on peut retrouver à la main la p-value,

> 1-pchisq(20.3861,df=18)
[1] 0.3115071

Faisons notre petite dessin de toutes les p-value, pour s’assurer que le bruit est bien un bruit blanc,

 BP=function(h) Box.test(residuals(fit.ar12),lag=h,
type='Box-Pierce')$p.value plot(1:24,Vectorize(BP)(1:24),type='b', ylim=c(0,1),col="red") abline(h=.05,lty=2,col="blue") Cette fois c’est bon, on tient notre premier modèle, un $AR(12)$. Si on veut aller plus loin, on peut regarder ce que donnerait de la sélection automatique, > library(caschrono) > armaselect(Y,nbmod=5) p q sbc [1,] 14 1 1635.214 [2,] 12 1 1635.645 [3,] 15 1 1638.178 [4,] 12 3 1638.297 [5,] 12 4 1639.232 On peut être tenté d’aller voir ce qui se passerait en rajoutant une composante moyenne mobile à notre modèle précédant, > fit.arma12.1=arima(Y,order=c(12,0,1)) > fit.arma12.1 Series: Y ARIMA(12,0,1) with non-zero mean Coefficients: ar1 ar2 ar3 ar4 ar5 ar6 ar7 0.0301 0.1558 -0.0941 -0.1461 0.1063 -0.0688 -0.002 s.e. 0.1235 0.0854 0.0757 0.0784 0.0807 0.0774 0.080 ar9 ar10 ar11 ar12 ma1 intercept -0.0646 -0.0798 0.2538 0.5786 0.2231 -131.3495 s.e. 0.0802 0.0766 0.0751 0.0861 0.1393 368.8156 sigma^2 estimated as 2127759: log likelihood=-945.65 AIC=1921.31 AICc=1926.52 BIC=1961.54 Le nouveau coefficient, $\theta_1$ est à peine significatif. Éventuellement avec un seuil à 10%… Pourquoi pas? Si on regarde les résidus, sans grande surprise, on a toujours un bruit blanc, encore plus blanc qu’auparavant (en violet sur le dessin ci-dessous) BP=function(h) Box.test( residuals(fit.arma12.1),lag=h, type='Box-Pierce')$p.value
plot(1:24,Vectorize(BP)(1:24),type='b',
ylim=c(0,1),col="red")
abline(h=.05,lty=2,col="blue")

BP=function(h) Box.test(residuals(fit.ar12),lag=h,
type='Ljung-Box')$p.value lines(1:24,Vectorize(BP)(1:24),col="purple", type="b") On peut aussi aller voir parmi les modèles proposés, en particulier le modèle $AR(14)$. > fit.ar14= + arima(Y,order=c(14,0,0),method="CSS") > fit.ar14 Series: Y ARIMA(14,0,0) with non-zero mean Coefficients: ar1 ar2 ar3 ar4 ar5 ar6 ar7 0.2495 0.2105 -0.0584 -0.1569 0.1282 -0.1152 0.0268 s.e. 0.0956 0.0972 0.0854 0.0830 0.0838 0.0840 0.0847 ar9 ar10 ar11 ar12 ar13 ar14 intercept -0.0327 -0.1116 0.2649 0.5887 -0.1575 -0.1572 80.5 s.e. 0.0855 0.0851 0.0853 0.0886 0.1031 0.0999 338.9 sigma^2 estimated as 2218612: part log likelihood=-942.31 C’est un peu tiré par les cheveux, mais on pourrait accepter l’hypothèse que $\phi_{14}$soit significativement non-nuls. Mais on est encore limite… Allez, on l’accepte aussi dans notre gang de modèle. On a finalement trois modèles. Si on fait un peu de backtesting, sur les 12 derniers mois, T=length(Y) backtest=12 subY=Y[-((T-backtest+1):T)] subtemps=1:(T-backtest) plot(temps,Y,type="l") lines(subtemps,subY,lwd=4) fit.ar12.s=arima(subY, order=c(p=12,d=0,q=0),method="CSS") fit.arma12.1.s=arima(subY, order=c(p=12,d=0,q=1),method="CSS") fit.ar14.s=arima(subY, order=c(p=14,d=0,q=0),method="CSS") p.ar12=predict(fit.ar12.s,12) pred.ar12=as.numeric(p.ar12$pred)
p.arma12.1=predict(fit.arma12.1.s,12)
pred.arma12.1=as.numeric(p.arma12.1$pred) p.ar14=predict(fit.ar14.s,12) pred.ar14=as.numeric(p.ar14$pred)

on obtient les prévisions suivantes (avec les valeurs observées dans la première colonne)

> (M=cbind(observé=Y[((T-backtest+1):T)],
+  modèle1=pred.ar12,
+  modèle2=pred.arma12.1,
+  modèle3=pred.ar14))
observé    modèle1    modèle2    modèle3
97  -4836.2174 -5689.3331 -5885.4486 -6364.2471
98  -3876.4199 -4274.0391 -4287.2193 -4773.8116
99   1930.3776  1817.8411  2127.9915  2290.1460
100  3435.1751  4089.3598  3736.1110  4039.4150
101  7727.9726  6998.9829  7391.6694  7281.4797
102  2631.7701  3456.8819  3397.5478  4230.5324
103  -509.4324 -2128.6315 -2268.9672 -2258.7216
104 -1892.6349 -3877.7609 -3694.9409 -3620.4798
105 -4310.8374 -3384.0905 -3430.4090 -2881.4942
106  2564.9600  -504.6883  -242.5018   183.2891
107 -1678.2425 -1540.9904 -1607.5996  -855.7677
108 -4362.4450 -3927.4772 -3928.0626 -3718.3922
>  sum((M[,1]-M[,2])^2)
[1] 19590931
>  sum((M[,1]-M[,3])^2)
[1] 17293716
>  sum((M[,1]-M[,4])^2)
[1] 21242230

I.e. on aurait envie de retenir le second modèle, $ARMA(12,1)$. On va maintenant l’utiliser pour faire un peu de prévision,

library(forecast)
fit.arma12.1=
arima(Y,order=c(12,0,1))
fit.arma12.1
PREDARMA=forecast(fit.arma12.1,12)
plot(Y,xlim=c(1,120),type="l")
temps=T+1:12
polygon(c(temps,rev(temps)),c(PREDARMA$lower[,2], rev(PREDARMA$upper[,2])),col="yellow",border=NA)
polygon(c(temps,rev(temps)),c(PREDARMA$lower[,1], rev(PREDARMA$upper[,1])),col="orange",border=NA)
lines(temps,PREDARMA$mean,col="red") Cela dit, on peut aussi aller beaucoup plus loin dans la prévision, PREDARMA=forecast(fit.arma12.1,120) plot(Y,xlim=c(1,210),type="l") temps=T+1:120 polygon(c(temps,rev(temps)),c(PREDARMA$lower[,2],
rev(PREDARMA$upper[,2])),col="yellow",border=NA) polygon(c(temps,rev(temps)),c(PREDARMA$lower[,1],
rev(PREDARMA$upper[,1])),col="orange",border=NA) lines(temps,PREDARMA$mean,col="red")

Bon, on y est presque, car on a modélisé $(Y_t)$, la série obtenue en enlevant la tendance linéaire. Pour remonter sur $(X_t)$, on va rajouter la tendance à la prévision faite auparavant,

X=as.numeric(Xt)
temps=1:length(X)
plot(temps,X,type="l",xlim=c(0,210),
ylim=c(5000,30000))
base=data.frame(temps,X)
reg=lm(X~temps)
abline(reg,col="red")
PREDTENDANCE=predict(reg,newdata=
data.frame(temps=T+1:120))
temps=T+1:120
polygon(c(temps,rev(temps)),c(PREDTENDANCE+
PREDARMA$lower[,2],rev(PREDTENDANCE+PREDARMA$upper[,2])),
col="yellow",border=NA)
polygon(c(temps,rev(temps)),c(PREDTENDANCE+
PREDARMA$lower[,1],rev(PREDTENDANCE+PREDARMA$upper[,1])),
col="orange",border=NA)
lines(temps,PREDTENDANCE+PREDARMA$mean,col="red") # Examen final ACT6420, énoncé L’examen ACT6420 aura lieu vendredi midi, et durera trois heures. Les Annexes (contenant 23 pages de sorties informatiques) sont en ligne ici. La moitié des questions porteront sur l’analyse de ces sorties. # Maximum likelihood estimates for multivariate distributions Consider our loss-ALAE dataset, and – as in Frees & Valdez (1998) – let us fit a parametric model, in order to price a reinsurance treaty. The dataset is the following, > library(evd) > data(lossalae) > Z=lossalae > X=Z[,1];Y=Z[,2] The first step can be to estimate marginal distributions, independently. Here, we consider lognormal distributions for both components, > Fempx=function(x) mean(X<=x) > Fx=Vectorize(Fempx) > u=exp(seq(2,15,by=.05)) > plot(u,Fx(u),log="x",type="l", + xlab="loss (log scale)") > Lx=function(px) -sum(log(Vectorize(dlnorm)( + X,px[1],px[2]))) > opx=optim(c(1,5),fn=Lx) > opx$par
[1] 9.373679 1.637499
> lines(u,Vectorize(plnorm)(u,opx$par[1], + opx$par[2]),col="red")

The fit here is quite good,

For the second component, we do the same,

> Fempy=function(x) mean(Y<=x)
> Fy=Vectorize(Fempy)
> u=exp(seq(2,15,by=.05))
> plot(u,Fy(u),log="x",type="l",
+ xlab="ALAE (log scale)")
> Ly=function(px) -sum(log(Vectorize(dlnorm)(
+ Y,px[1],px[2])))
> opy=optim(c(1.5,10),fn=Ly)
> opy$par [1] 8.522452 1.429645 > lines(u,Vectorize(plnorm)(u,opy$par[1],
+ opy$par[2]),col="blue") It is not as good as the fit obtained on losses, but it is not that bad, Now, consider a multivariate model, with Gumbel copula. We’ve seen before that it worked well. But this time, consider the maximum likelihood estimator globally. > Cop=function(u,v,a) exp(-((-log(u))^a+ + (-log(v))^a)^(1/a)) > phi=function(t,a) (-log(t))^a > cop=function(u,v,a) Cop(u,v,a)*(phi(u,a)+ + phi(v,a))^(1/a-2)*( + a-1+(phi(u,a)+phi(v,a))^(1/a))*(phi(u,a-1)* + phi(v,a-1))/(u*v) > L=function(p) {-sum(log(Vectorize(dlnorm)( + X,p[1],p[2])))- + sum(log(Vectorize(dlnorm)(Y,p[3],p[4])))- + sum(log(Vectorize(cop)(plnorm(X,p[1],p[2]), + plnorm(Y,p[3],p[4]),p[5])))} > opz=optim(c(1.5,10,1.5,10,1.5),fn=L) > opz$par
[1] 9.377219 1.671410 8.524221 1.428552 1.468238

Marginal parameters are (slightly) different from the one obtained independently,

> c(opx$par,opy$par)
[1] 9.373679 1.637499 8.522452 1.429645
> opz$par[1:4] [1] 9.377219 1.671410 8.524221 1.428552 And the parameter of Gumbel copula is close to the one obtained with heuristic methods in class. Now that we have a model, let us play with it, to price a reinsurance treaty. But first, let us see how to generate Gumbel copula… One idea can be to use the frailty approach, based on a stable frailty. And we can use Chambers et al (1976)to generate a stable distribution. So here is the algorithm to generate samples from Gumbel copula > alpha=opz$par[5]
> invphi=function(t,a) exp(-t^(1/a))
> n=500
> x=matrix(rexp(2*n),n,2)
> angle=runif(n,0,pi)
> E=rexp(n)
> beta=1/alpha
> stable=sin((1-beta)*angle)^((1-beta)/beta)*
+ (sin(beta*angle))/(sin(angle))^(1/beta)/
+ (E^(alpha-1))
> U=invphi(x/stable,alpha)
> plot(U)

Here, we consider only 500 simulations,

Based on that copula simulation, we can then use marginal transformations to generate a pair, losses and allocated expenses,

> Xloss=qlnorm(U[,1],opz$par[1],opz$par[2])
> Xalae=qlnorm(U[,2],opz$par[3],opz$par[4])

In standard reinsurance treaties – see e.g. Clarke (1996) – allocated expenses are splited prorata capita between the insurance company, and the reinsurer. If $X$ denotes losses, and $Y$ the allocated expenses, a standard excess treaty can be has payoff

$\begin{cases} 0\cdot \boldsymbol{1}(X\leq R)\\ \displaystyle{\left(X-R+ \frac{X-R}{X}\cdot Y\right) \right )}\cdot\boldsymbol{1}(R
where $L$ denotes the (upper) limit, and $R$ the insurer’s retention. Using monte carlo simulation, it is then possible to estimate the pure premium of such a reinsurance treaty.

> L=100000
> R=50000
> Z=((Xloss-R)+(Xloss-R)/Xloss*Xalae)*
+ (R<=Xloss)*(Xloss<L)+
+ ((L-R)+(L-R)/R*Xalae)*(L<=Xloss)
> mean(Z)
[1] 12596.45

Now, play with it… it is possible to find a better fit, I guess…

# OGM, ABC et mythologie scientifique

Une tentative de billet en cette fin de semaine pour revenir sur deux événements scientifiques récents, que certains pourraient trouver surprenant de rapprocher. Mais les deux événements sont liés à des publications (voire des prépublications) qui ont su faire le buzz, ces dernières semaines. Et si je les rapproche, c’est aussi probablement pour mieux les opposer.

• d’un coté, l’exclusivité du Nouvel Observateur sur les OGM, et sur l’article de Séralini et al. (2012). Pour reprendre les premières phrases de l’article, “c’est une véritable bombe que lance, ce 19 septembre à 15 heures, la très sérieuse revue américaine “Food and Chemical Toxicology” – une référence en matière de toxicologie alimentaire – en publiant les résultats…” Je ne reviendrais pas sur l’article que je n’ai pas compris (y compris la partie statistique, et je renvoie aux articles parus dans Le Monde ou Libération sur le décryptage) mais sur la perception médiatique de la recherche scientifique… On gardera aussi en mémoire dans le titre de Rue89, “Les OGM dangereux pour la santé : l’étude qui le prouve” (mais les deux sites appartiennent à la même boutique, c’est probablement normal d’y lire la même chose).
• de l’autre, les articles sur la conjecture d’Oesterlé-Masser, dite ABC, que Shinichi Mochizuki aurait démontré, dans Mochizuki (2012). Peu de journaux semblent en avoir parlé en France, mais le New York Times, par exemple, en parle, “with no fanfare, Shinichi Mochizuki, a mathematician at Kyoto University in Japan, dropped onto the Internet four papers.The papers, encompassing 500 pages and four years of effort, claim to solve an important problem in number theory known as the abc conjecture.” Après les précautions d’usage de journalistes qui ne cherchent pas un scoop, on apprend qu’un chercheur aurait résolu (ou prétend avoir résolu) un important problème mathématique. Certains sites comme Business Insider ne s’embarrassent pas trop de précautions, et titrent “World’s Most Complex Mathematical Theory ‘Cracked‘”. Si les éditeurs de ce site lisaient le Nouvel Obs, ils auraient peut-être écrit que “c’est une véritable bombe que lance” Shinichi Mochizuki.
Les deux évènements sont radicalement opposés selon moi. L’un étant avec et l’autre sans fanfare, comme le note le New York Times. Mais ce qui me dérange dans ces deux événements, c’est le mythe entretenu par certains journalistes sur le fonctionnement de la recherche. On se cache (autant que possible), et quand on est prêt (ou quand on pense l’être), on lance une “bombe” !
Je dois avouer que je rêve moi aussi d’écrire un article qui révolutionnerait le monde ! ou au moins mon monde, mon tout petit monde (pour reprendre le titre du livre de David Lodge)… Mais non, ce que je fais n’intéresse personne…
Et je ne crois pas non plus en la culture du secret, au contraire: dès que j’écris un truc, que je le présente dans une conférence, que ma grand mère en parle à une de ses amies au téléphone, j’en parle sur mon blog, et je mets les documents (y compris les codes pour les reproduire) sur mon blog. Car je ne me fais même plus d’illusion sur la portée de mes recherches. 24 articles ont cité des travaux que j’avais fait sur les comportements limites des copules Archimédiennes (dans la queue inférieure), mais 1 seul cite ceux sur les mesures d’inégalité et de pauvreté.
Ce qui est désolant, c’est cette vision du monde de la recherche; avec d’un coté, les chercheurs qui lancent des bombes, et de l’autre, ben…. les chercheurs qui admirent leurs collègues? qui les jalousent? qui se tournent les pouces? Ce n’est pas si simple que ça…. Par exemple, pour les travaux sur les OGM (ou sur le Roundup car je n’ai toujours pas compris si l’étude portait sur un OGM, ou sur un désherbant), les “les chercheurs français” ne sont probablement pas les seuls à publier sur le sujet !
Dans le cas d’ABC, Slate explique clairement les choses: “la démonstration du Japonais est détaillée dans quatre articles scientifiques (repris sur le site de Nature) qui reposent chacun sur d’autres longs articles“. Oui, ce n’est pas un chercheur tout seul qui a fait la découverte. Shinichi Mochizuki s’appuie “sur d’autres longs articles”, publiés par des chercheurs qui n’auront jamais leur heure de gloire, que l’histoire (y compris l’histoire des sciences) oubliera probablement… Mais ce n’est pas grave, car peu, très peu cherchent la gloire. Et tous fuient la médiatisation comme la peste !
Fort justement, The Telegraph posait l’autre jour la question suivante “How many scientists does it take to make a discovery?”. Intéressante question, n’est-ce-pas ? (et j’ai été déçu que l’article soit aussi court). Car oui, derrière les articles qui font du buzz, il y a des chercheurs qui cherchent… L’article note d’ailleurs dès le début que “the era of the lone genius, as epitomised by Albert Einstein, has long gone“… “long gone” ? Pas si sûr quand on voit la mythologie véhiculée par certains journalistes…. Il serait temps que ça change.

# Transformation logarithmique de séries temporelles

Pour poursuivre une discussion amorcée en fin de cours, dans certains cas, on peut avoir l’impression que modéliser une série pourrait être compliqué,

plot(X,xlim=c(1,length(X)+20))

Mais on peut avoir l’intuition que modéliser le logarithme de la série pourrait être plus simple,

> X=log(Y)
> plot(X,xlim=c(1,length(X)+20))

On va alors tenter une modélisation par un processus ARMA de cette dernière série,

> md=arima(X,c(12,0,1))
> P=predict(md,24)
> E=P$pred > V=P$se^2

On peut alors faire une prévision sur cette série plus simple à modéliser, et visualiser cette prévision.

> temps=length(X)+1:24
> ciu=(E+2*sqrt(V))
> cil=(E-2*sqrt(V))
> polygon(c(temps,rev(temps)),c(ciu,
+ rev(cil)),col="yellow",border=NA)
> lines(temps,E,col="red",lwd=2)
> lines(temps,ciu,col="red",lty=2)
> lines(temps,cil,col="red",lty=2)

Maintenant, on va devoir remonter. On va utiliser un résultat que l’on a vu sur la transformation logarithmique dans une régression: si après avoir pris le logarithme, on a un modèle simple, Gaussien, c’est que le modèle initial était log-normal. On peut alors utiliser les propriétés de la loi lognormale, dont on connait les moments à partir de ceux de la loi Gaussienne sous-jacente. Pour la prévision, on n’a pas trop le choix,

> mu=exp(E+.5*V)

Par contre, pour construire un intervalle de confiance, soit on utilise la variance de notre loi lognormale pour avoir la variance de notre processus, et on oublie cette histoire de loi lognormale pour construire un intervalle Gaussien,

> sig2=(exp(V)-1)*exp(2*E+V)
> ci1u=mu+2*sqrt(sig2)
> ci1l=mu-2*sqrt(sig2)

ou alors on utilise le fait que comme la transformation est monotone, l’intervalle de confiance peut etre vu comme une transformation du précédant intervalle de confiance,

> ci2u=exp(E+2*sqrt(V))
> ci2l=exp(E-2*sqrt(V))

Si on compare visuellement les deux, on a dans le premier cas,

> plot(Y,xlim=c(1,length(X)+20))
> temps=length(X)+1:24
> polygon(c(temps,rev(temps)),c(ci1u,
> rev(ci1l)),col="yellow",border=NA)
> lines(temps,mu,col="red",lwd=2)
> lines(temps,ci1u,col="red",lty=2)
> lines(temps,ci1l,col="red",lty=2)

(qui est symétrique et centré sur notre prévision) et dans le second

> plot(Y,xlim=c(1,length(X)+20))
> temps=length(X)+1:24
> ci1u=mu+2*sqrt(sig2)
> ci1l=mu-2*sqrt(sig2)
> polygon(c(temps,rev(temps)),c(ci2u,
> rev(ci2l)),col="yellow",border=NA)
> lines(temps,mu,col="red",lwd=2)
> lines(temps,ci2u,col="red",lty=2)
> lines(temps,ci2l,col="red",lty=2)

# (nonparametric) copula density estimation

Today, we will go further on the inference of copula functions. Some codes (and references) can be found on a previous post, on nonparametric estimators of copula densities (among other related things).  Consider (as before) the loss-ALAE dataset (since we’ve been working a lot on that dataset)

> library(MASS)
> library(evd)
> X=lossalae
> U=cbind(rank(X[,1])/(nrow(X)+1),rank(X[,2])/(nrow(X)+1))

The standard tool to plot nonparametric estimators of densities is to use multivariate kernels. We can look at the density using

> mat1=kde2d(U[,1],U[,2],n=35)
> persp(mat1$x,mat1$y,mat1$z,col="green", + shade=TRUE,theta=s*5, + xlab="",ylab="",zlab="",zlim=c(0,7)) or level curves (isodensity curves) with more detailed estimators (on grids with shorter steps) > mat1=kde2d(U[,1],U[,2],n=101) > image(mat1$x,mat1$y,mat1$z,col=
+ rev(heat.colors(100)),xlab="",ylab="")
> contour(mat1$x,mat1$y,mat1$z,add= + TRUE,levels = pretty(c(0,4), 11)) Kernels are nice, but we clearly observe some border bias, extremely strong in corners (the estimator is 1/4th of what it should be, see another post for more details). Instead of working on sample $(U_i,V_i)$ on the unit square, consider some transformed sample $(Q(U_i),Q(V_i))$, where $Q:(0,1)\rightarrow\mathbb{R}$ is a given function. E.g. a quantile function of an unbounded distribution, for instance the quantile function of the $\mathcal{N}(0,1)$ distribution. Then, we can estimate the density of the transformed sample, and using the inversion technique, derive an estimator of the density of the initial sample. Since the inverse of a (general) function is not that simple to compute, the code might be a bit slow. But it does work, > gaussian.kernel.copula.surface <- function (u,v,n) { + s=seq(1/(n+1), length=n, by=1/(n+1)) + mat=matrix(NA,nrow = n, ncol = n) + sur=kde2d(qnorm(u),qnorm(v),n=1000, + lims = c(-4, 4, -4, 4)) + su<-sur$z
+ for (i in 1:n) {
+     for (j in 1:n) {
+ 	Xi<-round((qnorm(s[i])+4)*1000/8)+1;
+ 	Yj<-round((qnorm(s[j])+4)*1000/8)+1
+ 	mat[i,j]<-su[Xi,Yj]/(dnorm(qnorm(s[i]))*
+ 	dnorm(qnorm(s[j])))
+     }
+ }
+ return(list(x=s,y=s,z=data.matrix(mat)))
+ }

Here, we get

Note that it is possible to consider another transformation, e.g. the quantile function of a Student-t distribution.

> student.kernel.copula.surface =
+  function (u,v,n,d=4) {
+  s <- seq(1/(n+1), length=n, by=1/(n+1))
+  mat <- matrix(NA,nrow = n, ncol = n)
+ sur<-kde2d(qt(u,df=d),qt(v,df=d),n=5000,
+ lims = c(-8, 8, -8, 8))
+ su<-sur$z + for (i in 1:n) { + for (j in 1:n) { + Xi<-round((qt(s[i],df=d)+8)*5000/16)+1; + Yj<-round((qt(s[j],df=d)+8)*5000/16)+1 + mat[i,j]<-su[Xi,Yj]/(dt(qt(s[i],df=d),df=d)* + dt(qt(s[j],df=d),df=d)) + } + } + return(list(x=s,y=s,z=data.matrix(mat))) + } Another strategy is to consider kernel that have precisely the unit interval as support. The idea is here to consider the product of Beta kernels, where parameters depend on the location > beta.kernel.copula.surface= + function (u,v,bx=.025,by=.025,n) { + s <- seq(1/(n+1), length=n, by=1/(n+1)) + mat <- matrix(0,nrow = n, ncol = n) + for (i in 1:n) { + a <- s[i] + for (j in 1:n) { + b <- s[j] + mat[i,j] <- sum(dbeta(a,u/bx,(1-u)/bx) * + dbeta(b,v/by,(1-v)/by)) / length(u) + } + } + return(list(x=s,y=s,z=data.matrix(mat))) + } On those two graphs, we can clearly observe strong tail dependence in the upper (right) corner, that cannot be intuited using a standard kernel estimator… # Examen final ACT6420 Chose promise, chose due: les deux bases de données qui seront utilisées pour l’examen sont désormais en ligne. 10 questions porteront sur l’analyse de la série temporelle suivante serie=read.table("http://freakonometrics.free.fr/exam-ts.txt") X=serie$x XTS=serie=ts(X,start=c(1999,9),frequency=12)

(qui peut être modélisée soit comme un objet série temporel, soit comme un vecteur numérique).

Enfin, 10 questions porteront sur la base de données suivante

examen=read.table( "http://freakonometrics.blog.free.fr/public/
data/basket-exam-v2.csv", header=TRUE,sep=";")

(si l’importation ne marche pas, veillez à ce que l’adresse du fichier tienne sur une ligne). Cette base devait servir initialement pour l’examen intra. Elle contient des matchs de baskets universitaires (aux États-Unis). Les variables sont les suivantes

• EQUIPE le nom de l’équipe qui sert de référence
• HALFDIFF le nombre de points de différence à la mi-temps (négatif signifie que l’EQUIPE perdait)
• WINNER vaut 1 si l’équipe a gagné le match, 0 sinon,
• TOTALPOINTSDIFF le nombre de points de différence à la fin du match
• SECONDHALFPOINTS est le nombre de points marqués par l’EQUIPE pendant la seconde mi-temps
• NODIFF_PTS_1000-LEFT la différence de points entre les équipes 10 minutes avant la fin du match (au milieu de la seconde période)
• HOMETEAM vaut 0 si l’équipe joue à l’extérieur, 1 si elle joue à domicile
• HALFWINNER vaut 1 si l’EQUIPE gagnait (supérieur ou nul) à la mi-temps
• HALFLOOSER vaut 1 si l’EQUIPE perdait (inférieur ou nul) à la mi-temps
• SECONDHALFPOINTSOTHER est le nombre de points marqués par l’adversaire au cours de la seconde mi-temps

La variable d’intérêt sera le nombre de points d’écart à la fin du match.

Enfin, 20 questions supplémentaires porteront sur la compréhension générale du cours. Les calculatrices seront autorisées. Maintenant, pour tous ceux qui ont encore du mal avec R, je recommande

• “R pour les débutants”d’Emmanuel Paradis (PDF)
• “Brise Glace-R” d’Andrew Robinson er Arnaud Schloesing (PDF)
• “Introduction à la programmation en R” de Vincent Goulet (PDF)

(les questions d’analyse de sortie ne porteront pas sur la programmation en R, mais davantage sur l’analyse critique des sorties, et leur interprétation).

# Copulas and tail dependence, part 3

We have seen extreme value copulas in the section where we did consider general families of copulas. In the bivariate case, an extreme value can be written

where $A(\cdot)$ is Pickands dependence function, which is a convex function satisfying

Observe that in this case,
where $\tau$ is Kendall’tau, and can be written
For instance, if
then, we obtain Gumbel copula. This is what we’ve seen in the section where we introduced this family. Now, let us talk about (nonparametric) inference, and more precisely the estimation of the dependence function. The starting point of the most standard estimator is to observe that if $(U,V)$ has copula $C$, then
has distribution function
And conversely, Pickands dependence function can be written

Thus, a natural estimator for Pickands function is

where $\widehat{H}_n$ is the empirical cumulative distribution function of
This is the estimator proposed in Capéràa, Fougères  & Genest (1997). Here, we can compute everything here using

> library(evd)
> X=lossalae
> U=cbind(rank(X[,1])/(nrow(X)+1),rank(X[,2])/
+ (nrow(X)+1))
> Z=log(U[,1])/log(U[,1]*U[,2])
> h=function(t) mean(Z<=t)
> H=Vectorize(h)
> a=function(t){
+ f=function(t) (H(t)-t)/(t*(1-t))
+ return(exp(integrate(f,lower=0,upper=t,
+ subdivisions=10000)$value)) + } > A=Vectorize(a) > u=seq(.01,.99,by=.01) > plot(c(0,u,1),c(1,A(u),1),type="l",col="red", + ylim=c(.5,1)) Even integrate to get an estimator of Pickands’ dependence function. Note that an interesting point is that the upper tail dependence index can be visualized on the graph, above, > A(.5)/2 [1] 0.4055346 # Copulas and tail dependence, part 2 An alternative to describe tail dependence can be found in the Ledford & Tawn (1996) for instance. The intuition behind can be found in Fischer & Klein (2007)). Assume that and have the same distribution. Now, if we assume that those variables are (strictly) independent, But if we assume that those variables are (strictly) comonotonic (i.e. equal here since they have the same distribution), then So assume that there is a such that Then =2 can be interpreted as independence while =1 means strong (perfect) positive dependence. Thus, consider the following transformation to get a parameter in [0,1], with a strength of dependence increasing with the index, e.g. In order to derive a tail dependence index, assume that there exists a limit to which will be interpreted as a (weaktail dependence index. Thus define concentration functions for the lower tail (on the left) and for the upper tail (on the right). The R code to compute those functions is quite simple, > library(evd); > data(lossalae) > X=lossalae > U=rank(X[,1])/(nrow(X)+1) > V=rank(X[,2])/(nrow(X)+1 > fL2emp=function(z) 2*log(mean(U<=z))/ + log(mean((U<=z)&(V<=z)))-1 > fR2emp=function(z) 2*log(mean(U>=1-z))/ + log(mean((U>=1-z)&(V>=1-z)))-1 > u=seq(.001,.5,by=.001) > L=Vectorize(fL2emp)(u) > R=Vectorize(fR2emp)(rev(u)) > plot(c(u,u+.5-u[1]),c(L,R),type="l",ylim=0:1, + xlab="LOWER TAIL UPPER TAIL") > abline(v=.5,col="grey") and again, it is possible to plot those empirical functions against some parametric ones, e.g. the one obtained from a Gaussian copula (with the same Kendall’s tau) > tau=cor(lossalae,method="kendall")[1,2] > library(copula) > paramgauss=sin(tau*pi/2) > copgauss=normalCopula(paramgauss) > Lgaussian=function(z) 2*log(z)/log(pCopula(c(z,z), + copgauss))-1 > Rgaussian=function(z) 2*log(1-z)/log(1-2*z+ + pCopula(c(z,z),copgauss))-1 > u=seq(.001,.5,by=.001) > Lgs=Vectorize(Lgaussian)(u) > Rgs=Vectorize(Rgaussian)(1-rev(u)) > lines(c(u,u+.5-u[1]),c(Lgs,Rgs),col="red") or Gumbel copula, > paramgumbel=1/(1-tau) > copgumbel=gumbelCopula(paramgumbel, dim = 2) > Lgumbel=function(z) 2*log(z)/log(pCopula(c(z,z), + copgumbel))-1 > Rgumbel=function(z) 2*log(1-z)/log(1-2*z+ + pCopula(c(z,z),copgumbel))-1 > Lgl=Vectorize(Lgumbel)(u) > Rgl=Vectorize(Rgumbel)(1-rev(u)) > lines(c(u,u+.5-u[1]),c(Lgl,Rgl),col="blue") Again, one should look more carefully at confidence bands, but is looks like Gumbel copula provides a good fit here. # Copulas and tail dependence, part 1 As mentioned in the course last week Venter (2003) suggested nice functions to illustrate tail dependence (see also some slides used in Berlin a few years ago). • Joe (1990)’s lambda Joe (1990) suggested a (strong) tail dependence index. For lower tails, for instance, consider i.e • Upper and lower strong tail (empirical) dependence functions The idea is to plot the function above, in order to visualize limiting behavior. Define for the lower tail, and for the upper tail, where is the survival copula associated with , in the sense that while Now, one can easily derive empirical conterparts of those function, i.e. and Thus, for upper tail, on the right, we have the following graph and for the lower tail, on the left, we have For the code, consider some real data, like the loss-ALAE dataset. > library(evd) > X=lossalae The idea is to plot, on the left, the lower tail concentration function, and on the right, the upper tail function. > U=rank(X[,1])/(nrow(X)+1) > V=rank(X[,2])/(nrow(X)+1) > Lemp=function(z) sum((U<=z)&(V<=z))/sum(U<=z) > Remp=function(z) sum((U>=1-z)&(V>=1-z))/sum(U>=1-z) > u=seq(.001,.5,by=.001) > L=Vectorize(Lemp)(u) > R=Vectorize(Remp)(rev(u)) > plot(c(u,u+.5-u[1]),c(L,R),type="l",ylim=0:1, + xlab="LOWER TAIL UPPER TAIL") > abline(v=.5,col="grey") Now, we can compare this graph, with what should be obtained for some parametric copulas that have the same Kendall’s tau (e.g.). For instance, if we consider a Gaussian copula, > tau=cor(lossalae,method="kendall")[1,2] > library(copula) > paramgauss=sin(tau*pi/2) > copgauss=normalCopula(paramgauss) > Lgaussian=function(z) pCopula(c(z,z),copgauss)/z > Rgaussian=function(z) (1-2*z+pCopula(c(z,z),copgauss))/(1-z) > u=seq(.001,.5,by=.001) > Lgs=Vectorize(Lgaussian)(u) > Rgs=Vectorize(Rgaussian)(1-rev(u)) > lines(c(u,u+.5-u[1]),c(Lgs,Rgs),col="red") or Gumbel’s copula, > paramgumbel=1/(1-tau) > copgumbel=gumbelCopula(paramgumbel, dim = 2) > Lgumbel=function(z) pCopula(c(z,z),copgumbel)/z > Rgumbel=function(z) (1-2*z+pCopula(c(z,z),copgumbel))/(1-z) > u=seq(.001,.5,by=.001) > Lgl=Vectorize(Lgumbel)(u) > Rgl=Vectorize(Rgumbel)(1-rev(u)) > lines(c(u,u+.5-u[1]),c(Lgl,Rgl),col="blue") That’s nice (isn’t it?), but since we do not have any confidence interval, it is still hard to conclude (even if it looks like Gumbel copula has a much better fit than the Gaussian one). A strategy can be to generate samples from those copulas, and to visualize what we had. With a Gaussian copula, the graph looks like > u=seq(.0025,.5,by=.0025); nu=length(u) > nsimul=500 > MGS=matrix(NA,nsimul,2*nu) > for(s in 1:nsimul){ + Xs=rCopula(nrow(X),copgauss) + Us=rank(Xs[,1])/(nrow(Xs)+1) + Vs=rank(Xs[,2])/(nrow(Xs)+1) + Lemp=function(z) sum((Us<=z)&(Vs<=z))/sum(Us<=z) + Remp=function(z) sum((Us>=1-z)&(Vs>=1-z))/sum(Us>=1-z) + MGS[s,1:nu]=Vectorize(Lemp)(u) + MGS[s,(nu+1):(2*nu)]=Vectorize(Remp)(rev(u)) + lines(c(u,u+.5-u[1]),MGS[s,],col="red") + } (including – pointwise – 90% confidence bands) > Q95=function(x) quantile(x,.95) > V95=apply(MGS,2,Q95) > lines(c(u,u+.5-u[1]),V95,col="red",lwd=2) > Q05=function(x) quantile(x,.05) > V05=apply(MGS,2,Q05) > lines(c(u,u+.5-u[1]),V05,col="red",lwd=2) while it is with Gumbel copula. Isn’t it a nice (graphical) tool ? But as mentioned in the course, the statistical convergence can be slow. Extremely slow. So assessing if the underlying copula has tail dependence, or not, it now that simple. Especially if the copula exhibits tail independence. Like the Gaussian copula. Consider a sample of size 1,000. This is what we obtain if we generate random scenarios, or we look at the left tail (with a log-scale) Now, consider a 10,000 sample, or with a log-scale We can even consider a 100,000 sample, or with a log-scale On those graphs, it is rather difficult to conclude if the limit is 0, or some strictly positive value (again, it is a classical statistical problem when the value of interest is at the border of the support of the parameter). So, a natural idea is to consider a weaker tail dependence index. Unless you have something like 100,000 observations… # Ordres d’un processus ARMA Dans la méthodologie de Box & Jenkins, une étape qui arrive très rapidement est le choix des ordres du processus , une fois que l’on validé l’hypothèse de stationnarité de la série, comme on l’a vu en cours la semaine passée. Considérons la série du trafic autoroutier, > autoroute=read.table( +"http://freakonometrics.blog.free.fr/public/data/autoroute.csv", + header=TRUE,sep=";") > a7=autoroute$a007
> A7=ts(a7,start = c(1989, 9), frequency = 12)

Un outils pratique de sélections des ordres  et  dans un modèle  est la fonction d’autocorrélation étendue. La définition est donnée dans les notes de cours (Def. 223) à partir des statistiques proposées par Tsay & Tiao (1984),

>  EACF=eacf(A7)
AR/MA
0 1 2 3 4 5 6 7 8 9 10 11 12 13
0 x o o x x x x x o o x  x  x  o
1 x x o o x x x o o o x  x  x  x
2 o x o o o o x o o o o  x  x  o
3 o x o x o o o o o o o  x  x  x
4 x x x x o o o o o o o  x  o  o
5 x x o o o x o o o o o  x  o  x
6 x x o o o x o o o o o  x  o  o
7 o x o o o x o o o o o  x  o  o
>  EACF
$eacf [,1] [,2] [,3] [,4] [1,] 0.6476234 0.2124105 -0.02413173 -0.24234535 [2,] 0.4889076 0.2797152 -0.02494135 -0.06094037 [3,] 0.1006541 -0.2285771 0.03514148 0.08000588 [4,] 0.1390240 -0.2788742 0.04386746 0.28307260 [5,] -0.5091680 0.3144899 -0.34572269 0.31450865 [6,] -0.4224571 -0.4877505 0.16054232 -0.09130728 [7,] -0.4731353 -0.4324857 -0.04847184 -0.10500350 [8,] -0.2129591 -0.4072901 0.09487899 -0.06493243 [,5] [,6] [,7] [,8] [1,] -0.514330187 -0.61634046 -0.52314403 -0.28008661 [2,] -0.254912957 -0.28966664 -0.33963243 -0.21863077 [3,] -0.156624357 -0.01199786 -0.25116738 0.13079231 [4,] -0.183283544 0.03651508 -0.08711829 0.11626377 [5,] -0.190885091 -0.09786463 -0.09182557 0.08818875 [6,] -0.072904071 0.29271777 -0.09334712 0.01972648 [7,] -0.009873289 0.36909726 0.01698660 -0.03317456 [8,] 0.020485930 0.38342158 0.16981715 -0.02592442 [,9] [,10] [,11] [,12] [1,] -0.082607058 0.15178887 0.56583179 0.8368975 [2,] -0.085026400 0.02731460 0.26158357 0.7844748 [3,] 0.001866994 -0.11658312 0.03038621 0.7026361 [4,] 0.025183793 -0.21608692 0.05660781 0.6674301 [5,] -0.006831894 -0.02514440 -0.07390257 0.4762563 [6,] 0.010058718 -0.03888613 -0.04382043 0.5338091 [7,] 0.032124905 -0.07022090 -0.04427400 0.4674165 [8,] 0.024189179 -0.20818201 0.01459933 0.4830369 [,13] [,14] [1,] 0.5637439 0.17862571 [2,] 0.4530716 0.24413569 [3,] 0.2534178 -0.20160890 [4,] 0.2409861 -0.29462510 [5,] -0.1517324 -0.14763294 [6,] -0.1701182 -0.28771495 [7,] -0.1651515 0.05466457 [8,] -0.1403198 -0.04095030$ar.max
[1] 8

$ma.ma [1] 14 Les ronds dans la matrice désignent des valeurs non-significatives. Par défaut, le nombre de retards, pris en compte pour la composante autorégressive est faible, mais on peut l’augmenter. > EACF=eacf(A7,13,13) AR/MA 0 1 2 3 4 5 6 7 8 9 10 11 12 13 0 x o o x x x x x o o x x x o 1 x x o o x x x o o o x x x x 2 o x o o o o x o o o o x x o 3 o x o x o o o o o o o x x x 4 x x x x o o o o o o o x o o 5 x x o o o x o o o o o x o x 6 x x o o o x o o o o o x o o 7 o x o o o x o o o o o x o o 8 o x o o o x o o o o o x o o 9 x x o o x o x o o o o x o o 10 x x o o x o x o o o o x o o 11 x x o o x x x o o o x x o o 12 x x o o o o o o o o o o o o 13 x x o o o o o o o o o o o o > EACF$eacf
[,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9] [,10]
[1,]  0.64  0.21 -0.02 -0.24 -0.51 -0.61 -0.52 -0.28 -0.08  0.15
[2,]  0.48  0.27 -0.02 -0.06 -0.25 -0.28 -0.33 -0.21 -0.08  0.02
[3,]  0.10 -0.22  0.03  0.08 -0.15 -0.01 -0.25  0.13  0.00 -0.11
[4,]  0.13 -0.27  0.04  0.28 -0.18  0.03 -0.08  0.11  0.02 -0.21
[5,] -0.50  0.31 -0.34  0.31 -0.19 -0.09 -0.09  0.08  0.00 -0.02
[6,] -0.42 -0.48  0.16 -0.09 -0.07  0.29 -0.09  0.01  0.01 -0.03
[7,] -0.47 -0.43 -0.04 -0.10  0.00  0.36  0.01 -0.03  0.03 -0.07
[8,] -0.21 -0.40  0.09 -0.06  0.02  0.38  0.16 -0.02  0.02 -0.20
[9,] -0.14 -0.50 -0.10 -0.06  0.11  0.38 -0.01 -0.02 -0.08 -0.20
[10,] -0.29  0.48  0.00  0.18  0.27 -0.12  0.41  0.00  0.16  0.15
[11,]  0.24  0.48 -0.04  0.02  0.46  0.10  0.37 -0.10  0.05  0.16
[12,] -0.59  0.49 -0.18  0.05  0.31 -0.32  0.34 -0.16  0.07  0.16
[13,] -0.31  0.31 -0.12  0.16 -0.11  0.04 -0.04  0.12 -0.09  0.00
[14,]  0.47  0.26  0.11  0.13 -0.01 -0.01  0.00  0.07 -0.03  0.02

On peut aussi visualiser graphiquement les différentes valeurs, avec en ordonnée les ordres autoréregressifs () et en abscisse les ordres moyenne mobile ().

> library(RColorBrewer)
> CL=brewer.pal(6, "RdBu")
> ceacf=matrix(as.numeric(cut(EACF$eacf, +1,nrow(EACF$eacf),
+ ncol(EACF$eacf)) > for(i in 1:ncol(EACF$eacf)){
+ for(j in 1:nrow(EACF$eacf)){ + polygon(c(i-1,i-1,i,i)-.5,c(j-1,j,j,j-1)-.5, + col=CL[ceacf[j,i]]) + }} Un bruit blanc est en bas à gauche ( et nuls). Dans cette méthode, dite méthode des coins, on cherche un coin telle que dans le quadrant supérieur, les valeurs soient non-significatives (ternes sur le dessin ci-dessus). La figure ci-desssous correspond à l’analyse d’un modèle Les fortes valeurs positives sont en bleu foncé, les fortes valeurs négatives sont en rouge foncé. On peut aussi regarder la fonction suivante, qui utilise une identification de modèle par MINIC (Minimum Information Criterion) à l’aide du critère de Shcwarz (BIC, ou SBC Schwarz’s Bayesian Criterion) > armaselect(A7,nbmod=5) p q sbc [1,] 12 1 1441.798 [2,] 13 0 1442.628 [3,] 12 0 1443.188 [4,] 12 2 1443.362 [5,] 14 0 1445.069 Enfin, une dernière fonction possible est évoquée dans la section 6.5. du livre deCryer & Chan (2008), > ARMA.SELECTION= + armasubsets(A7,nar=14,nma=14,ar.method='ols') > plot(ARMA.SELECTION) basé sur le critère de Schwarz. Je vais me répéter, mais ces méthodes ne sont que des outils, histoire d’avoir des pistes si on ne sait trop dans quelle direction partir. Et compte tenu de la saisonnalité de la série, je serais pour ma part parti sur un modèle avec =12, histoire de voir si on ne pourrait pas avoir un modèle simple, et facilement interprétable en plus… 1. -3):3)/3,labels=1:6 [] # Copulas estimation and influence of margins Just a short post to get back on results mentioned at the end of the course. Since copulas are obtained using (univariate) quantile functions in the joint cumulative distribution function, they are – somehow – related to the marginal distribution fitted. In order to illustrate this point, consider an i.i.d. sample from a Student-t distribution, library(mnormt) r=.5 n=200 X=rmt(n,mean=c(0,0),S=matrix(c(1,r,r,1),2,2),df=4) Thus, the true copula is Student-t. Here, with 4 degrees of freedom. Note that we can easily get the (true) value of the copula, on the diagonal dg=function(t) pmt(qt(t,df=4),mean=c(0,0), S=matrix(c(1,r,r,1),2,2),df=4) DG=Vectorize(dg) Four strategies are considered here to define pseudo-copula base variates, • misfit: consider an invalid marginal estimation: we have assumed that margins were Gaussian, i.e. • perfect fit: here, we know that margins were Student-t, with 4 degrees of freedom • standard fit: then, consider the case where we fit marginal distribution, but in the good family this time (e.g. among Student-t distributions), • ranks: finally, we consider nonparametric estimators for marginal distributions, Now that we have a sample with margins in the unit square, let us construct the empirical copula, Let us now compare those four approaches. • The first one is to illustrate model error, i.e. what’s going on if we fit distributions, but not in the proper family of parametric distributions. X0=cbind((X[,1]-mean(X[,1])/sd(X[,1])), (X[,2]-mean(X[,2])/sd(X[,2]))) Y=pnorm(X0) Then, the following code is used to compute the value of the empirical copula, on the diagonal, diagonale=function(t,Z) mean((Z[,1]<=t)&(Z[,2]<=t)) diagY=function(t) diagonale(t,Y) DiagY=Vectorize(diagY) u=seq(0,1,by=.005) dY=DiagY(u) On the graph below, 1,000 samples of size 200 have been generated. All trajectories are the estimation of the copula on the diagonal. The black plain line is the true value of the copula Obviously, it is not good at all. Mainly because the distribution of can’t be a copula, since margins are not even uniform on the unit interval. • a perfect fit. Here, we use the following code to generate our copula-type sample U=pt(X,df=4) This time, the fit is much better. • Using maximum likelihood estimators to fit the best distribution within the Student-t family F1=fitdistr(X0[,1],dt,list(df=5),lower = 0.001) F2=fitdistr(X0[,2],dt,list(df=5),lower = 0.001) V=cbind(pt(X0[,1],df=F1$estimate),pt(X0[,2],df=F2\$estimate))

Here, it is also very good. Even better than before, when the true distribution is considered.

(it is like using Lillie test for goodness of fit, versus Kolmogorov-Smirnov, seehere for instance, in French).

• Finally, let us consider ranks, or nonparametric estimators for marginal distributions,
R=cbind(rank(X[,1])/(n+1),rank(X[,2])/(n+1))

Here it is even better then the previous one

If we compare Box-plots of the value of the copula at point (.2,.2), we obtain the following, with on top ranks, then fitting with the good family, then using the true distribution, and finally, using a non-proper distribution.

Just to illustrate one more time a result mentioned in a previous post, “in statistics, having too much information might not be a good thing“.