Monthly Archives: June 2014

Copulas, MAT8595

Conditional Distributions from some Elliptical Vectors

6 Comments

This winter, in my ACT8595 course, I asked my students (that was some homework) to prove that it was possible to derive the conditional distribution when we have a Student-t random vector (and to get the analytical expression of the later). But before, let us recall a standard result about the Gaussian vector. If  is a Gaussian random vector, i.e.

then  has a Gaussian distribution. More precisely, it is a  distribution, with

and  is the Schur complement of the block  of the matrix ,

Observe that  is also related to well known quantity: in the bivariate case, where  and  are univariate Gaussian variables,

which is the slope in the linear regression of  on .

In the case of the Student-t distribution, the conditional distrubution will not be a Student-t distribution anymore, but it will still be an elliptical distribution, and some interpretations of various quantities can actually be obtained.

The density of the multivariate centred Student-t distribution, with unit variance, and parameters  and  is

https://latex.codecogs.com/gif.latex?f(\boldsymbol{x})=%20\frac{\Gamma([d+\nu]/2)}{(\nu\pi)^{d/2}%20\Gamma(\nu/2)\vert\boldsymbol{R}\vert^{1/2}}%20\left(%201+\frac{1}{\nu}\boldsymbol{x}%27\boldsymbol{R}^{-1}\boldsymbol{x}%20\right)^{-(d+\nu)/2}

If we consider the following blocks,

https://latex.codecogs.com/gif.latex?\boldsymbol{R}=%20\left(%20\begin{array}{cc}%20\boldsymbol{R}_{11}&%20\boldsymbol{R}_{12}\\%20\boldsymbol{R}_{21}&%20\boldsymbol{R}_{22}%20\end{array}%20\right)

then we can get that marginal distributions have a centred Student-t distribution, with unit variance, and parameters  and ,

https://latex.codecogs.com/gif.latex?f_2(\boldsymbol{x}_2)=%20\frac{\Gamma([d_2+\nu]/2)}{(\nu\pi)^{d_2/2}%20\Gamma(\nu/2)\vert\boldsymbol{R}_{22}\vert^{1/2}}%20\left(%201+\frac{1}{\nu}\boldsymbol{x}_2%27\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_2%20\right)^{-(d_2+\nu)/2}

Then, to derive the conditional density, we can use Bayes formula,

https://latex.codecogs.com/gif.latex?f_{1\vert%202}(\boldsymbol{x}_1\vert%20\boldsymbol{x}_2)=%20\frac{f(\boldsymbol{x}_1,\boldsymbol{x}_2)}{f_2(\boldsymbol{x}_2)}

One can write (as in Section 9.1 in Tong, 1990, The Multivariate Normal Distribution, but other expressions can be found in Section 2.5 in Fang, Ng and Kotz, 1989, Symmetric multivariate and related distributions, or in Section 1.11 in Kotz and Nadarajah, 2004, Multivariate t distributions and their applications) this conditional density as

https://latex.codecogs.com/gif.latex?f_{1\vert%202}(\boldsymbol{x}_1\vert%20\boldsymbol{x}_2)=\kappa%20\left(1+\frac{1}{\nu}\boldsymbol{x}_2%27\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_2\right)^{(d_2+\nu)/2}%20\left(1+\frac{1}{\nu}\left[\boldsymbol{x}_2%27\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_2+\alpha(\boldsymbol{x}_1,\boldsymbol{x}_2)\right]\right)^{-(d_1+\nu)/2}

with

https://latex.codecogs.com/gif.latex?\kappa=\frac{\Gamma([d+\nu]/2)}{(\nu\pi)^{d_1/2}%20\Gamma([d_2+\nu]/2)}\frac{1}{\vert\boldsymbol{R}_{11}-\boldsymbol{R}_{12}\boldsymbol{R}_{22}^{-1}\boldsymbol{R}_{21}\vert^{1/2}}

and

https://latex.codecogs.com/gif.latex?\alpha(\boldsymbol{x}_1,\boldsymbol{x}_2)=(\boldsymbol{x}_1-\boldsymbol{R}_{12}\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_{2})%27%20[\boldsymbol{R}_{11}-\boldsymbol{R}_{12}\boldsymbol{R}_{22}^{-1}\boldsymbol{R}_{21}]^{-1}(\boldsymbol{x}_1-\boldsymbol{R}_{12}\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_{2})

This conditional distribution is elliptical, but it is not a Student-t distribution, except in the case where , or when the correlation matrix  is the identity.

[June 2016] actually, as shown in Ding (2016), this is a Student-t distribution. “Kotz & Nadarajah (2004) and Nadarajah & Kotz (2005) failed to recognize that the conditional distribution of the MVT distribution is also a MVT distribution due to the complexity of the conditional density function […] Conditional distributions of elliptically contoured distributions are also elliptically contoured distributions. But this does not immediately guarantee that conditional distributions of the MVT distributions are also MVT distributions without some further algebra.“

Now, if we look at the components of this density, we can observe that we have

https://latex.codecogs.com/gif.latex?(\boldsymbol{x}_1-\boldsymbol{R}_{12}\boldsymbol{R}_{22}^{-1}\boldsymbol{x}_{2})

which was mentioned previously, in the Gaussian case: the term on the right is the conditional mean,

and the bloc that appears at several places is the conditional variance,

Now, if we want to visualize that conditional density, let us plot it. The code below is based on Bayes formula

> library(mnormt)
> r=.6
> R=matrix(c(1,r,r,1),2,2)
> nu=4
> f2=function(x2) dt(x2,df=nu)
> f =function(x) dmt(x,S=R,df=nu)
> f1.2=function(x1,x2) f(c(x1,x2))/f2(x2)

In order to compare that conditional density with a Student-t one, let us define the density of a non-centred Student-t random variable,

> dstd=function(x,mu,s,nu) gamma((nu+1)/2)/
+ (gamma(nu/2)*s*sqrt(pi*nu))*
+ (1+1/nu*(x-mu)^2/(s^2))^(-(nu+1)/2)

Here is the function we can use to plot those two densities,

> graphdensity=function(x2=-1.5){
+ vectx1=seq(-3,3,length=251)
+ y=Vectorize(function(x) f1.2(x,x2))(vectx1)
+ plot(vectx1,y,type="l",col="red",ylim=c(0,.5),
+ xlab="",ylab="")
+ abline(v=r*x2,lty=2)
+ lines(vectx1,dstd(vectx1,x2*r,sqrt(1-r^2),nu),col="blue",lty=2)}
> graphdensity(-1.5)

In the case where , the two lines are rather close (the difference migth come from computational issues)

> graphdensity(-1)

and just to conclude, a last one

> graphdensity(0)

Copulas, MAT8595, Maths, Probability

On Hoeffding’s identity

1 Comment

In 1940, Wassily Hoeffding published Masstabinvariante Korrelationstheorie, which was an impressive paper. For those (like me) who unfortunately barely speak German, an English translation could be found in The Collected Works of Wassily Hoeffding, published a few years ago. As I keep saying in my courses about copulas, almost everything was in that paper, by Wassily Hoeffding. For instance, we can see the following graph, of a cumulative distribution function,

What is the difference with a copula? A copula (in dimension 2) is the cumulative distribution function of a random pair with uniform on , as defined by Abe Sklar

But Wassily Hoeffding considered a random pair with uniform on . But everything else is the same. He can even derive the level curves of the density of the Gaussian copula,

> library(mnormt)
> r=.6
> dc=function(u,v) return(
+ as.numeric(dmnorm(cbind(qnorm(u),qnorm(v)),varcov=
+ matrix(c(1,r,r,1),2,2))/dnorm(qnorm(u))/dnorm(qnorm(v))))
> n=500
> vectu=seq(1/n,1-1/n,length=n-1)
> matdc=outer(vectu,vectu,dc)
> contour(vectu,vectu,matdc,levels=
+ c(.325,.944,1.212,1.250,1.290,1.656,3.85),lwd=2)

 

But another interesting point is that there is the so-called Hoeffding’s equality

which is interesting, and quite important, actually, to understand that the covariance (or the correlation) can be seen as some ‘distance‘ to the independence. More precisely, observe that

where  would be the joint cumulative distribution function of some independent variables, with the same marginal distributions.

Of course, it is not exactly a distance, since it can be negative. But still. Now, the thing is that the proof is not trivial. But it is using interesting identities. For instance, in 1885, Franklin wrote a nice paper, Proof of a Theorem of Tchebycheff’s on Definite Integrals, in the American Journal of Mathematics. To get some heuristics about the identity, consider some (finite) sequences  and , then one can prove that

And there is a continuous version of that identity. Consider two bounded functions  and , on some interval,  then

is equal to

In 1979, in Monotone Regression and Covariance Structure, Gerald Shea gave a more probabilistic interpretation of that results, using the fact that

and using a different measure. More precisely, assume now that  functions  and  are integrable, with respect to some measure , on some set . Then

is equal to

In the case where  is a probability measure of , i.e. , this equality is the one used by Wassily Hoeffding, in 1940. The interpretation in terms of random variable is simple that

(with standard assuptions of existence of those quantitites) where  and  are two independent vectors, with identical distribution, . Actually, this relationship can also be found in Some Concepts of Dependence, by E. L. Lehmann, published in 1966. Oh, and by the way, the connection with Chebyshev inequality (claimed in the title of seminal paper by Franklin) come from the fact that if  and  are monotonic, then the left part of the identity is positive, and thus,

But let’s get back to Hoeffiding’s result. How do we get it from that lemma. The idea is to write

as

i.e.

We can then intervert the integral and the expectation, use the fact that

and then, and some integral calculus can be used to rewrite that expression as

So we get here Hoeffding’s identity. Actually, as mentioned by Ben Derrett about the equality above, it can be observed (see http://math.stackexchange.com/105713) that2\text{cov}(X,Y)=2\big(\mathbb{E}[XY]-\mathbb{E}[X]\mathbb{E}[Y]\big)can also be written

where again,  and  are two independent vectors, with identical distribution, . The later can be writen

Academe, Miscellaneous

Blogues de Sciences Francophones ?

8 Comments

Allez, je me lance… je vais rompre avec la règle d’or que connaît tout chercheur vivant dans le monde académique : ne jamais parler de ses échecs. Il est en effet de bon ton de dire “j’ai un financement du NSERC” mais pas de dire “sur mes cinq demandes de financement, toutes ont été rejetées. Sauf Une.” On peut raconter une anecdote sur les papiers rejetés, autour d’un café, mais mieux vaut éviter de dire qu’on a eu plus de lettres de rejet que de lettres d’acceptation dans sa boîte de messagerie. Et surtout, ne jamais l’écrire à l’encre indélébile. Oups.

A deux reprises la semaine passée, je discutais avec des blogueurs, chercheurs comme moi pendant leur temps libre (ou le contraire, je finis par me perdre), et les deux m’ont dit “tiens, on ne t’a pas vu dans la compilation des blogues de sciences francophones“. Eh oui, je crois que je ne suis pas dedans, effectivement. Cela dit, comme tout bon chercheur, j’ai bien entendu une explication ! Voire plusieurs !

☐ “mon travail est trop avant-gardiste pour être comparé aux autres“
☐ “c’est un complot, les gens derrières ce classement ne m’aiment pas“
☐ “ce que je fais, c’est plus que de la science, c’est de l’art, tu sais“
☑ “c’est nul de mettre les gens dans des cases, et je ne suis pas exclusivement francophone“

On l’occurrence, j’aime effectivement prendre comme (piètre) excuse la langue. Car je suis militant – voire activiste – en faveur des blogs de sciences. Ce qui rend vexant de ne pas être retenu comme blogueur de sciences. En revanche, la langue m’indiffère! Comme mon blog est professionnel, j’ai tendance à bloguer en anglais, mais quand il faut écrire de manière un peu plus subtile, pour éviter les malentendus, je recours à ma langue maternelle. Si je blogue à l’occasion en anglais, c’est que c’est plus simple: tout ce que je lis ou presque est en anglais.

Maintenant, comme tous les chercheurs, j’ai aussi un amour propre (et un égo) démesuré, et comme toujours les échecs, ça touche un peu. Car, ami lecteur, derrière ce blog que tu consultes régulièrement (si ce n’est pas encore le cas, il va falloir changer tes habitudes !) il y a du travail (mine de rien). Et sentir son travail un peu valorisé, ça fait toujours plaisir. Il y a quelques semaines, j’avais invité Pascal Lapointe (a.k.a. @paslap, qui a justement dirigé la publication du livre compilant les blogs) pour un café, car je voulais discuter de vulgarisation et de blogs de sciences justement. Et il m’expliquait qu’il ne comprenait pas le sens academic blogging, que j’avais pris l’habitude d’utiliser (par exemple en mettant en avant le blog de Paul Krugman : sous prétexte qu’il est académique, peut-on dire que son blog est un blog académique ? et je pense qu’il a raison, ce qui m’a fait reprendre le terme utilisé par hypotheses.org, carnet de sciences ouvert). Mais je persiste sur l’importance de donner un nom à cet activité que nous exerçons, pour savoir comment la positionner. Puis-je parler de mon blog dans mes demandes de subventions (mon blog peut donner une forte exposition à mes travaux) ? Puis-je financer avec mes fonds de recherche des livres que j’achète pour faire un billet sur mon blog, et pas un article de recherche (pour l’instant je finance avec mes sous personnels, ce sont des cadeaux en moins pour mes enfants à Noël) ? Puis-je héberger des travaux de mes élèves sur mon blog, comme billets invités ? On avait lancé le débat dans les commentaires d’un vieux billet, et je pense que j’essayerais de le poursuivre car je pense qu’il est important.

Maintenant, pour revenir à cette compilation, la petite histoire est que l’an passé, plusieurs personnes m’avaient sollicité. Des gens qui lançaient la compilation, mais aussi les éditeurs de mon blog. Pour le premier, la logique est simple : un recensement n’a de sens que si l’éventail est large; pour les second, être présent dans ces compilations donne une grande visibilité. Les démarches étaient simples (de mémoire) : il fallait envoyer deux posts qui pourraient être les ambassadeurs du blog. J’avoue ne plus trop savoir ce que j’ai retenu, et ne pas avoir compris non plus ce à quoi je participais… Si je l’ai fait, c’est parce que j’avais cru comprendre qu’il s’agirait d’une espèce de recensement, avec une liste aussi complète que possible (plusieurs personnes le font, et c’est probablement très intéressant, je pense au particulier à l’initiative visant à recenser des blogs de sciences féminins). Mais ex-post, j’ai l’impression qu’il s’agissait d’une espèce de concours (car il semble qu’il y ait un jury qui a fait une sélection). Dans ce cas, autant mettre les choses au clair : je veux bien que mon blog se retrouve cité dans des listes diverses et variées, mais je ne vais pas l’inscrire à des concours de beauté ! La raison est simple : je passe mon temps à me faire évaluer, et à évaluer les autres1 . J’ai toujours revendiqué mon blog comme un espace de liberté au sein du monde académique. L’humiliation, je garde ça pour mon travail d’enseignant et de chercheur (ça fait partie de la vie de touts les jours) par contre, je ne garde que les bons côtés du monde académique pour mon blog. J’écris sur les sujets que je veux, je me fais plaisir en essayant de répondre à des questions que je me pose, ou dans le meilleur des cas, qu’on me pose… Mais ne me demandez plus, s’il vous plait, de l’inscrire de nouveau à un concours de beauté !

Voilà, c’est dit.

1 rédaction de dossier pour des demandes de financement (où je dois faire croire que je suis le meilleur et que ma recherche va sauver l’humanité), lecture des évaluations des cours par mes élèves (qui adorent les profs sympas qui font des blagues et qui mettent des bonnes notes), réception de rapports de relecture par des pairs (qui n’ont pas aimé mon papier et qui me demande au moins de citer 3 papiers écrits par la même personne sans grand rapport avec mes travaux), évaluation de rapports de collègues (qui veulent des financements que je me suis fait refuser l’an passé), élaboration d’un projet de demande de financement pour un étudiant de maîtrise, etc.

2 les images sont tirées de l’excellent Little Miss Sunshine.

2014-E, ACT6420, Regression

Tukey and Mosteller’s Bulging Rule (and Ladder of Powers)

4 Comments

When discussing transformations in regression models, I usually briefly introduce the Box-Cox transform (see e.g. an old post on that topic) and I also mention local regressions and nonparametric estimators (see e.g. another post). But while I was working on my ACT6420 course (on predictive modeling, which is a VEE for the SOA), I read something about a “Ladder of Powers Rule” also called “Tukey and Mosteller’s Bulging Rule“. To be honest, I never heard about this rule before. But that won’t be the first time I learn something while working on my notes for a course !

The point here is that, in a standard linear regression model, we have

But sometimes, a linear relationship is not appropriate. One idea can be to transform the variable we would like to model, , and to consider

This is what we usually do with the Box-Cox transform. Another idea can be to transform the explanatory variable, , and now, consider,

For instance, this year in the course, we considered – at some point – a continuous piecewise linear functions,

It is also possible to consider some polynomial regression. The “Tukey and Mosteller’s Bulging Rule” is based on the following figure.

and the idea is that it might be interesting to transform  and  at the same time, using some power functions. To be more specific, we will consider some linear model

for some (positive) parameters  and . Depending on the shape of the regression function (the four curves mentioned on the graph above, in the four quadrant) different powers will be considered.

To be more specific, let us generate different models, and let us look at the associate scatterplot,

> fakedataMT=function(p=1,q=1,n=99,s=.1){
+ set.seed(1)
+ X=seq(1/(n+1),1-1/(n+1),length=n)
+ Y=(5+2*X^p+rnorm(n,sd=s))^(1/q)
+ return(data.frame(x=X,y=Y))}
> par(mfrow=c(2,2))
> plot(fakedataMT(p=.5,q=2),main="(p=1/2,q=2)")
> plot(fakedataMT(p=3,q=-5),main="(p=3,q=-5)")
> plot(fakedataMT(p=.5,q=-1),main="(p=1/2,q=-1)")
> plot(fakedataMT(p=3,q=5),main="(p=3,q=5)")

If we consider the South-West part of the graph, to get such a pattern, we can consider

or more generally

where  and  are both larger than 1. And the larger  and/or , the more convex the regression curve.

Let us visualize that double transformation on a dataset, say the cars dataset.

> base=cars
­> names(base)=c("x","y")
> MostellerTukey=function(p=1,q=1){
+ regpq=lm(I(y^q)~I(x^p),data=base)
+ u=seq(min(min(base$x)-2,.1),max(base$x)+2,length=501)
+ par(mfrow=c(1,2))
+ plot(base$x,base$y,xlab="X",ylab="Y",col="white")
+ vic=predict(regpq,newdata=data.frame(x=u),interval="prediction")
+ vic[vic<=0]=.1
+ polygon(c(u,rev(u)),c(vic[,2],rev(vic[,3]))^(1/q),col="light blue",density=40,border=NA)
+ lines(u,vic[,2]^(1/q),col="blue")
+ lines(u,vic[,3]^(1/q),col="blue")
+ v=predict(regpq,newdata=data.frame(x=u))^(1/q)
+ lines(u,v,col="blue")
+ points(base$x,base$y)
+ 
+ plot(base$x^p,base$y^q,xlab=paste("X^",p,sep=""),ylab=paste("Y^",q,sep=""),col="white")
+ polygon(c(u,rev(u))^p,c(vic[,2],rev(vic[,3])),col="light blue",density=40,border=NA)
+ lines(u^p,vic[,2],col="blue")
+ lines(u^p,vic[,3],col="blue")
+ abline(regpq,col="blue")
+ points(base$x^p,base$y^q)
+ }

For instance, if we call

> MostellerTukey(2,1)

we get the following graph,

On the left, we have the original dataset,  and on the right, the transformed one, , with two possible transformations. Here, we did only consider the square of the speed of the car (and only one component was transformed, here). On that transformed dataset, we run a standard linear regression. We add, here, a confidence tube. And then, we consider the inverse transformation of the prediction. This line is plotted on the left. The problem is that it should not be considered as our optimal prediction, since it is clearly biased because . But quantiles associated with a monotone transformation are the transformed quantiles. So confidence tubes can still be considered as confidence tubes.

Note that here, it could have be possible to consider another transformation, with the same shape, but quite different

> MostellerTukey(1,.5)

Of course, there is no reason to consider a simple power function, and the Box-Cox transform can also be used. The interesting point is that the logarithm can be obtained as a particular case. Furthermore, it is also possible to seek optimal transformations, seen here as a pair of parameters. Consider

> p=.1
> bc=boxcox(y~I(x^p),data=base,lambda=seq(.1,3,by=.1))$y
> for(p in seq(.2,3,by=.1)) bc=cbind(bc,boxcox(y~I(x^p),data=base,lambda=seq(.1,3,by=.1))$y)
> vp=boxcox(y~I(x^p),data=base,lambda=seq(.1,3,by=.1))$x
> vq=seq(.1,3,by=.1)
> library(RColorBrewer)
> blues=colorRampPalette(brewer.pal(9,"Blues"))(100)
> image(vp,vq,bc,col=blues)
> contour(vp,vq,bc,levels=seq(-60,-40,by=1),col="white",add=TRUE)

The darker, the better (here the log-likelihood is considered). The optimal pair is here

> bc=function(a){p=a[1];q=a[2]; as.numeric(-boxcox(y~I(x^p),data=base,lambda=q)$y[50])}
> optim(c(1,1), bc,method="L-BFGS-B",lower=c(0,0),upper=c(3,3))
$par
[1] 0.5758362 0.3541601

$value
[1] 47.27395

and indeed, the model we get is not bad,

Fun, ins’t it?

Big Data, IA-data science

Data science pour actuaire

Leave a comment

Je vais relayer ici un peu d’information. A Paris, l’Institut du Risk Management va proposer une formation “Data science pour actuaire“ qui débutera durant le 1er semestre 2015. Il s’agit d’une formation de 170 heures (à raison de 2 jours et demi par mois), pour 20-25 actuaires, qui sera sanctionnée par un examen, et qui donnera accès au diplôme “data scientist“ de l’Institut du Risk Management. Au programme, l’environnement Big Data (30 h), méthodologie statistique (50 h), mise en oeuvre informatique (50 h) et études de cas (40 h). Pour plus d’info, il faut envoyer un message à datascience@institutdesactuaires.com. J’essayerais de poster des informations au fur et à mesure ! A suivre donc…

Conferences, Trip

Càdiz, Nonparametric Statistics

Leave a comment

Emmanuel Flachaire will be presenting some joint work in Càdiz, Spain, tomorrow evening, at the second conference of the International Society of NonParametric Statistics. Jeff invited me a few months ago, to go there, but unfortunately, I’ve already been moving a lot recently. The talk will be based on the same work that I mentioned at the SSC annual conference (Canadian Statistical Society), in Toronto, at the end of May. His talk is on quantiles and inequality indices estimation from heavy-tailed distribution. As mentioned in my previous post, we will upload the slides (and the paper) in a close future.

So, Emmanuel will go there, and enjoy the beach (and the conference, the program is truly amazing).

2014-E, ACT6420, Time Series

Google, et prévision

Leave a comment

Pour le second devoir du cours ACT6420 (modèles de prévisions), le but est de prévoir des recherches sur Google, via https://www.google.com/trends/. Soit vous avez un mot clé qui vous intéresse, soit vous allez chercher une série extraite dans /ACT6420-TS/. Dans les bases qui ont été mises en ligne, il y a le mot clé gym, par exemple.

> report=read.table(
+ "http://freakonometrics.free.fr/ACT6420-TS/report-GYM.csv",
+ skip=4,header=TRUE,sep=",",nrows=548)

On va nettoyer un peu la base (en particulier les valeurs manquantes de la fin)

> tail(report)
                    Semaine gym
543 2014-05-25 - 2014-05-31  80
544 2014-06-01 - 2014-06-07  80
545 2014-06-08 - 2014-06-14  78
546 2014-06-15 - 2014-06-21  NA
547 2014-06-22 - 2014-06-28  NA
548 2014-06-29 - 2014-07-05  NA
> report=report[!is.na(report[,2]),]
> tail(report)
                    Semaine gym
540 2014-05-04 - 2014-05-10  79
541 2014-05-11 - 2014-05-17  80
542 2014-05-18 - 2014-05-24  79
543 2014-05-25 - 2014-05-31  80
544 2014-06-01 - 2014-06-07  80
545 2014-06-08 - 2014-06-14  78

Les données sont ici hebdomadaires, comme on peut le voir graphiquement

> hebdo=ts(report$gym,start=2004,frequency=52)
> hebdo
Time Series:
Start = c(2004, 1) 
End = c(2014, 25) 
Frequency = 52 
  [1]  68  60  60  53  55  50  49  49  51  48  48  45  45
 [14]  47  42  48  46  47  46  47  47  46  47  46  45  46
 [27]  46  50  48  48  52  51  57  55  53  56  55  50  48
 [40]  50  46  49  46  48  49  48  46  50  47  46  43  54
 [53]  69  64  63  60  57  57  53  54  55  54  50  53  54
 [66]  46  50  50  49  49  49  47  49  48  49  50  49  49
 [79]  47  47  50  49  52  51  55  55  55  54  54  52  53
 [92]  54  53  52  51  51  50  51  48  52  50  47  45  56
[105]  76  72  66  64  63  59  53  56  57  58  54  55  54
[118]  53  52  52  50  53  50  51  49  51  51  50  50  48
[131]  48  53  52  56  58  57  60  62  62  63  59  58  58
[144]  56  54  54  53  53  54  53  50  55  54  53  51  56
[157]  77  73  68  68  67  66  64  67  64  63  63  63  62
[170]  62  61  62  61  63  62  63  63  63  63  59  58  59
[183]  61  60  60  58  61  61  62  62  64  68  66  61  58
[196]  58  55  54  51  55  54  55  53  55  53  52  50  55
[209]  76  77  68  67  64  64  58  61  59  59  57  55  57
[222]  59  57  54  56  55  54  52  52  53  54  53  55  55
[235]  55  57  54  56  55  58  65  63  64  67  66  63  62
[248]  60  60  57  55  56  56  58  58  53  56  55  54  52
[261]  69  77  71  68  66  63  60  60  62  59  59  57  57
[274]  60  58  58  56  54  58  57  56  57  57  57  57  54
[287]  54  55  57  57  56  64  60  59  62  62  64  59  58
[300]  57  57  54  53  52  53  53  55  53  55  53  50  49
[313]  63  76  73  68  65  66  60  61  61  60  58  58  61
[326]  61  62  57  57  58  55  58  57  58  59  57  55  55
[339]  57  57  58  59  59  60  60  63  63  63  66  65  62
[352]  60  59  58  57  56  58  59  56  54  57  54  54  53
[365]  66  87  77  74  72  69  68  64  65  65  68  63  65
[378]  65  65  62  61  62  62  63  63  61  65  63  64  63
[391]  61  62  62  61  62  65  63  67  67  71  74  71  70
[404]  68  68  65  66  64  65  68  64  64  65  62  61  60
[417]  69  91  88  83  81  78  75  71  73  74  73  70  69
[430]  66  68  69  66  68  68  65  69  66  69  70  69  70
[443]  69  72  72  71  69  76  74  72  77  77  82  78  72
[456]  72  69  68  67  67  64  66  66  63  65  64  62  61
[469]  67  88  90  83  81  83  77  76  76  74  75  74  74
[482]  77  77  77  73  72  76  72  71  72  74  72  74  73
[495]  73  76  73  73  71  76  76  79  79  83  83  81  78
[508]  78  76  78  80  74  73  75  74  75  72  71  70  69
[521]  73  92 100  94  93  91  86  84  84  85  85  83  82
[534]  83  83  78  79  80  80  79  80  79  80  80  78

> plot(hebdo)

Pour avoir des modèles plus simples, on peut agréger les données, pour les rendre mensuelles (par interpolation linéaire). La fonction à utiliser est ici

        H2M=function(BASE){
 	X=BASE[,2]
 	Y=BASE[,1]
 	date1=substr(as.character(Y),1,10)
 	date2=substr(as.character(Y),14,23)
 	D1=as.Date(date1,"%Y-%m-%d")
 	D2=as.Date(date2,"%Y-%m-%d")
 	vm=vy=N=NA
 	for(t in 1:length(D1)){
 		mois=seq(D1[t],D2[t],length=7)
 		vm=c(vm,as.POSIXlt(mois)$mon+1)
 		vy=c(vy,as.POSIXlt(mois)$year+1900)
 		N=c(N,rep(X[t],7))}
 	N=N[-1]; vm=vm[-1]; vy=vy[-1]
 	YM=vy*100+vm
 	Z=tapply(N,as.factor(YM),mean)
 	Zts=ts(as.numeric(Z),start=c(2004,1),frequency=12)
 	return(Zts)}

Si on utilise cette fonction sur nos données, on obtient

> mensuel=H2M(report)
> mensuel
          Jan      Feb      Mar      Apr      May      Jun
2004 60.25000 50.75862 47.51613 45.66667 46.67742 46.00000
2005 63.22581 55.10714 53.03226 49.10000 48.45161 49.10000
2006 68.87097 57.10714 55.51613 51.86667 50.70968 49.93333
2007 70.74194 65.57143 62.87097 61.60000 62.77419 59.96667
2008 70.45161 60.79310 57.19355 56.13333 52.96774 54.30000
2009 70.35484 61.25000 58.19355 57.13333 56.80645 56.00000
2010 69.87097 61.78571 59.45161 58.76667 57.16129 56.40000
2011 76.58065 66.21429 65.22581 62.66667 62.51613 63.16667
2012 85.00000 73.82759 69.93548 67.76667 67.25806 69.46667
2013 84.93548 76.39286 75.00000 74.80000 72.67742 73.13333
2014 94.29032 84.96429 83.29032 79.80000 79.54839 79.00000
          Jul      Aug      Sep      Oct      Nov      Dec
2004 47.80645 53.67742 52.63333 47.77419 47.96667 47.61290
2005 48.41935 53.51613 53.43333 52.41935 50.20000 49.74194
2006 52.48387 59.77419 59.66667 54.12903 52.86667 54.35484
2007 59.87097 62.03226 63.10000 54.45161 54.30000 54.09677
2008 55.45161 62.16129 63.96667 57.41935 56.23333 56.09677
2009 55.96774 61.12903 60.16667 54.29032 53.60000 53.35484
2010 58.12903 61.64516 63.43333 57.67742 56.73333 56.48387
2011 61.80645 66.22581 70.86667 65.77419 65.23333 63.19355
2012 71.48387 75.06452 75.80000 67.22581 64.90000 65.12903
2013 73.51613 78.93548 79.73333 76.41935 73.93333 72.80645
2014                                                      
> ts.plot(mensuel)

Cette base est maintenant utilisable pour le devoir. Le but est ici de faire de la prévision pour les 2 prochaines années, avec un intervalle de confiance. Mais j’en reparlerais par courriel.

2014-E, ACT6420, Course, Time Series

Prévision de séries chronologiques

Leave a comment

Dans la seconde partie du cours de modèles de prévision, on quittera (un peu) les données individuelles pour parler de données chronologiques. Les slides de cette semaine (et probablement la semaine prochaine) sont en ligne.

J’ai mis en ligne, en parallèle, quelques notes de cours sur les séries temporelles, qui pourront peut être servir de complément. Comme le disait Doug Martin “Time series is the worst subject to teach. First, you have to teach the standard theory. Then, if you are beging honest, you have to tell the students ‘none of this stuff works, and this is what people really do'” (cité la semaine passée par David J. Thomson, au congrès de la SSC). On essayera de garder ça en mémoire tout au long du cours !

2014-E, ACT6420, Regression

Modèles de prévision, fourre-tout

Leave a comment

Dans le dernier cours de modèle de prévision, la semaine passée, nous avions passé un peu de temps sur l’étude des points aberrants et des points influents. Tout est expliqué dans les slides (avec les codes) donc je ne reviendrais pas dessus. Je pourrais juste évoquer quelques lignes de codes utilisées pour voir l’impact d’une observation sur la régression, en enlevant l’observation de la base, et en regardant ce que ça donne sur la prévision

> plot(cars)
> text(cars[c(23,49),1],cars[c(23,49),2]+4,c(23,49))
> abline(lm(dist~speed,data=cars))
> abline(lm(dist~speed,data=cars[-23,]),col="red")
> abline(lm(dist~speed,data=cars[-49,]),col="blue")

On a ensuite vu les problèmes de choix de modèles, et les méthodes de pénalisation (pénalisation du R2, et de la log-vraisemblance). On a ensuite vu les méthodes automatiques de choix de modèle,

> US=read.table("http://freakonometrics.free.fr/US.txt",sep=";")
> reg=lm(Murder~.,data=US)
> regs=step(reg)

Start:  AIC=63.01
Murder ~ Population + Income + Illiteracy + Life.Exp + HS.Grad + 
    Frost + Area

             Df Sum of Sq    RSS    AIC
- Income      1     0.236 128.27 61.105
- HS.Grad     1     0.973 129.01 61.392
<none>                    128.03 63.013
- Area        1     7.514 135.55 63.865
- Illiteracy  1     8.299 136.33 64.154
- Frost       1     9.260 137.29 64.505
- Population  1    25.719 153.75 70.166
- Life.Exp    1   127.175 255.21 95.503

Step:  AIC=61.11
Murder ~ Population + Illiteracy + Life.Exp + HS.Grad + Frost + 
    Area

             Df Sum of Sq    RSS    AIC
- HS.Grad     1     0.763 129.03 59.402
<none>                    128.27 61.105
- Area        1     7.310 135.58 61.877
- Illiteracy  1     8.715 136.98 62.392
- Frost       1     9.345 137.61 62.621
- Population  1    27.142 155.41 68.702
- Life.Exp    1   127.500 255.77 93.613

Step:  AIC=59.4
Murder ~ Population + Illiteracy + Life.Exp + Frost + Area

             Df Sum of Sq    RSS    AIC
<none>                    129.03 59.402
- Illiteracy  1     8.723 137.75 60.672
- Frost       1    11.030 140.06 61.503
- Area        1    15.937 144.97 63.225
- Population  1    26.415 155.45 66.714
- Life.Exp    1   140.391 269.42 94.213

Enfin, on a aussi vu le passage au logarithme sur la variable d’intérêt, avec un modèle log-normal,

> plot(cars$speed,cars$dist)
> regln=lm(log(dist)~speed,data=cars)
> summary(regln)

Call:
lm(formula = log(dist) ~ speed, data = cars)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.46604 -0.20800 -0.01683  0.24080  1.01519 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  1.67612    0.19614   8.546 3.34e-11 ***
speed        0.12077    0.01206  10.015 2.41e-13 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.4463 on 48 degrees of freedom
Multiple R-squared:  0.6763,	Adjusted R-squared:  0.6696 
F-statistic: 100.3 on 1 and 48 DF,  p-value: 2.413e-13

> beta=coefficients(regln)
> for(x in seq(2,30,by=.1)){
+ zhat=beta[1]+beta[2]*x
+ yhat=exp(zhat+1/2*0.4463^2)
+ points(x,exp(zhat),col="red")
+ points(x,yhat,col="blue")
+ }
> abline(lm(dist~speed,data=cars))

Pour comparer les modèles (linéaire versus log-linéaire), on avait suggéré de comparer les résidus des deux modèles,

> U=cars$dist - exp(predict(regln)+1/2*0.4463^2)

> sd(U)
[1] 17.12949
> sd(residuals(lm(dist~speed,data=cars)))
[1] 15.22184

Ce soir, on fini cette première partie du cours, sur les données individuelles.

Actuarial science, Books, Books, Readings, Research, Statistics

Approches Statistiques du Risque

Leave a comment

Il semble que l’ouvrage approches statistiques du risque, édité par Jean Jacques Droesbeke, Myriam Maumy-Bertrand, Gilbert Saporta et Christine Thomas-Agnan soit finalement paru, selon Gilbert Saporta. Ou devraient paraître – au pire – dans les jours à venir (je le vois pas encore sur le site de Technip). Les 400 pages reprennent les mini-cours que nous avions fait aux Journées d’Etudes Statistique de 2010, au CIRM, avec Patrice Bertail, Anne-Laure Fougères, Stéphane Loisel, Philippe Naveau, Eric Parent et Jean-Marc Tallon. Pour ma part, mes slides et mes notes de cours traînent quelque part sur le blog. Je garde un très bon souvenir de cette semaine de mini-cours, qui présentaient l’avantage d’être très complets, avec une introduction aux mesures de risques et aux lien avec la théorie de la décision, à la théorie du risque, aux notions simples d’extrêmes, de lois multivariés, et d’extrêmes multivariés, avec des applications en hydrologie, en santé, et en assurance. Avec bien entendu l’introduction historique de Jean Jacques. Même si les documents ont été écrits voilà déjà presque cinq ans, j’ai survolé mes chapitres il y a quelques semaines, et j’ai l’impression qu’ils restent d’actualité pour tous ceux qui s’intéressent au sujet (et ils sont nombreux me semble-t-il).

Statistics

Box plot, Fisher’s style

6 Comments

In a recent issue of Significance, I discovered an interesting – and amuzing – figure, about some box & beard plot, in Dr Fisher’s casebook: Beard the statistician in his den.

In French, the box plot (introduced by John Tukey, not George Box, as discussed in a previous post) is popular under the name boîte à moustaches (box with a mustache, for a simple translation).

> set.seed(2)
> x=rnorm(500)
> boxplot(x,horizontal=TRUE,axes=FALSE)
> axis(1)

I was wondering if it was possible to reproduce that Fisher’s style of box plot, with a beard (Ronald Fisher was famous for his beard). Technically, it is not complicated,

> boxplot(x,horizontal=TRUE,xlim=c(-1,1.3),axes=FALSE)
> axis(1)
> Q=quantile(x,c(.25,.75))
> y=cut(x[(x>=Q[1])&(x<=Q[2])],seq(Q[1],Q[2],length=11))
> tb=table(y)
> u=seq(Q[1],Q[2],length=11)
> umid=(u[1:10]+u[2:11])/2
> for(i in 1:10) segments(umid[i],1-.2,umid[i],1-.2-tb[i]/20,lwd=3)

Yes, I kept the mustaches here, but ploting a simple box, one could easily draw a goatee, or a chin strip

> rect(Q[1],1-.2,Q[2],1+.2)
> segments(median(x),1-.2,median(x),1+.2,lwd=2)

The only problem, is that between the first and the third quartiles, the distribution is much more ‘uniform‘ than it might look on the figure in Significance. Unless, perhaps, if add more bars on the left of the first quartile, and on the right of the third one,

> du=diff(umid)[1]
> y=cut(x,seq(Q[1]-du*8,Q[2]+du*8,length=11+16))
> tb=table(y)
> u=seq(Q[1]-du*8,Q[2]+du*8,length=11+16)
> umid=(u[1:26]+u[2:27])/2
> for(i in 1:8) segments(umid[i],1,umid[i],1-.2-tb[i]/20,lwd=3)
> for(i in 19:26) segments(umid[i],1,umid[i],1-.2-tb[i]/20,lwd=3)

Of course, we can try to add a smile on that face, below the mustache,

> vu=seq(-2.5,2.5,by=.02)
> vv=dnorm(vu)
> lines(vu,1-vv*4,col="red",lty=2)
> d=density(x,bw=.1)
> lines(d$x,1-d$y*4,col="red")

So far, I am not convinced. I mean, it should be possible to add something on the box plot,  to add more information. But I still wonder what… maybe using colors?