Bout de code : procédure de Shorrocks et Wan

Aller en bas

Bout de code : procédure de Shorrocks et Wan

Message  flbresson le Lun 27 Fév - 16:53

Besoin de données micro de revenus ? Oui mais pas de chance car vous n'avez que quelques points de la courbe de Lorenz. La procédure de Shorrocks et Wan (2008) est faite pour vous (papier ici). L'idée est de retoucher les données obtenues par l'ajustement d'une loi de distribution connue (la lognormale par exemple) de manière à retrouver la courbe de Lorenz initiale. Ci-suivent deux fonctions pour procéder à l'ajustement:

D'abord la fonction mu.L permet de retrouver les revenus moyens pour chaque intervalle de population défini en abscisse de la courbe de Lorenz:
Code:
mu.L   <-   function(L, p)   {   
      a   <- length(p)
      (L[-1]-L[-a])/(p[-1]-p[-a])   }

Attention, les valeurs retournées correspondent à un revenu moyen normalisé à l'unité.

Ensuite la fonction d'ajustement proprement dite:
Code:
ungroup   <-   function(y, p, mu.vrai, mu.gen)   {
      mu.group <-   function(x)   {
                  truc   <-   sapply(p[-1], quantile, x=x)
                  zob   <-   length(truc)
                  machin   <-   function(t) mean(x[x>truc[t-1] & x<truc[t]])
                  c(mean(x[x<truc[1]]), sapply(2:zob, machin))   }
      step2   <-   function(x){
                  t   <-   which(borne==max(borne[borne<x]))
                  ifelse((mu.vrai[t]>mu.step1[t] & t<m)==TRUE, (borne[t+1]-(borne[t+1]-mu.vrai[t])/(borne[t+1]-mu.step1[t])*(borne[t+1]-x)), (borne[t]+(mu.vrai[t]-borne[t])/(mu.step1[t]-borne[t])*(x-borne[t])))   }

      mu   <-   mu.group(y)
      m   <-   length(mu)
      group   <-   colSums(matrix(rep.int(y,m),nrow=m,byrow=TRUE)>mu)

      y.step1   <-   rep.int(NA,length(y))
      y.step1[y<mu[1]]   <-   y[y<mu[1]]*mu.vrai[1]/mu[1]
      y.step1[y>=mu[m]]   <-   y[y>=mu[m]]*mu.vrai[m]/mu[m]
      a   <-   y>=mu[1] & y<mu[m]
      y.step1[a]   <-   mu.vrai[group[a]]+(mu.vrai[group[a]+1]-mu.vrai[group[a]])/(mu[group[a]+1]-mu[group[a]])*(y[a]-mu[group[a]])
      mu.step1   <-   mu.group(y.step1)

      truc   <-   sapply(p[-c(1,length(p))], quantile, x=y.step1)
      b.inf   <-   function(a) max(y.step1[y.step1<a])
      b.sup   <-   function(a) min(y.step1[y.step1>a])
      borne   <-   c(0, .5*sapply(truc,b.inf)+.5*sapply(truc,b.sup))
      sapply(y.step1, step2)*mu.gen   }

où y est la série à ajuster, p le vecteurs de quantiles de population utilisé pour la courbe de Lorenz, mu.gen est le revenu moyen de la distribution initiale et mu.vrai les moyennes par groupe de population (obtenus avec la fonction mu.L). Exemple d'utilisation avec en premier étape estimation de la Lorenz avec une lognormale:

Code:

X<-   as.data.frame(cbind(0:10/10,c(0,.01,.03,.06,.11,.17,.25,.35,.5,.7,1)))
colnames(X)   <-   c("p","L")
mu.gen   <-   1500
n   <-   1000

f   <-  function(sigma) sum((X$L-pnorm(qnorm(X$p)-sigma))^2)
a   <-   nrow(X)
sig.ini   <-   mean(qnorm(X$p[-c(1,a)])-qnorm(X$L[-c(1,a)]))
sig   <-   optim(sig.ini, f, method="BFGS")$par
y.synth   <-   qlnorm((1:n)/(n+1),-sig^2/2,sig) #distrib moy égale 1
      
mu.x   <-   mu.L(X$L,X$p)
y.fin   <-   ungroup(y.synth, X$p, mu.x, mu.gen)

# Pour voir le résultat
library(ineq)
matplot(cbind(X$p,Lc(y.fin)$p,Lc(y.fin)$p),cbind(X$L,Lc(y.synth)$L,Lc(y.fin)$L),type="l")
legend("topleft",legend=c("original","lognorm", "adjusted"),lty=1:3,col=1:3)
avatar
flbresson

Messages : 360
Date d'inscription : 19/11/2009
Age : 39
Localisation : Clermont-Ferrand

Voir le profil de l'utilisateur http://sites.google.com/site/flbresson2/

Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum