-
Notifications
You must be signed in to change notification settings - Fork 1
/
Graphique Fisher.Rmd
161 lines (140 loc) · 5.75 KB
/
Graphique Fisher.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
```{r}
library(ggplot2)
library(reshape2)
library(dplyr)
library("Synth")
library(tidyverse)
```
```{r}
capital=read.csv("Statistical_Capital.csv")
croiss=read.csv("Statistical_Growth-Accounts.csv")
travail=read.csv("Statistical_Labour.csv")
compte=read.csv("Statistical_National-Accounts.csv")
description=read.csv("Variable-Description.csv")
autre_pays=read.csv("WB_data2.csv")
```
```{r}
lignedata=c('X1995', 'X1996', 'X1997', 'X1998', 'X1999', 'X2000', 'X2001', 'X2002', 'X2003', 'X2004', 'X2005', 'X2006', 'X2007', 'X2008', 'X2009', 'X2010', 'X2011', 'X2012', 'X2013', 'X2014', 'X2015', 'X2016', 'X2017')#les colonnes de données
date=seq(2000, 2017)
```
#Préparation classique des données
```{r}
melt_ada <- function(vari,codei){
tableau=subset(compte,(var==vari)& code==codei)[c("country", lignedata,"var")]
indligneNA <- which(is.na(tableau),arr.ind=TRUE)[,1]
tableau=tableau[-indligneNA,]
df.melted <- melt(tableau,id=c('country','var'))
df.melted$temps=as.numeric(str_sub(df.melted$variable, 2, 5))
return (df.melted[-3])
}
```
```{r}
df.melted=inner_join(melt_ada('VA','TOT'),melt_ada("EMP",'TOT'),by=c("country","temps"))
df.melted$index=c(1:length((unique(df.melted$country))))
df.melted$value.x=as.numeric(df.melted$value.x)
```
#Calcul des résultats
```{r}
a=c(1:16,18:26)
dataprep.out=Synth::dataprep(foo=df.melted,
predictors = c("value.x","value.y"), #Les variables utilisé en contrôle
predictors.op = "median", #La manière dont on les prends en compte
time.predictors.prior = 2000:2012, #période pré-traitement
dependent="value.x", #variable d'intérêt
unit.variable = "index", #colonne avec les index des pays
unit.names.variable="country", #nom des pays
treatment.identifier = 17, # n° de l'unité traitée
controls.identifier = a[a!=13], #n° des unités de contrôles
time.variable = 'temps', #colonne ou se trouve la date
time.optimize.ssr = 2000:2012, #période de maximisation
time.plot=1995:2017) #période tracée sur le graphique
synth.out <- Synth::synth(data.prep.obj = dataprep.out, method = "BFGS")
Synth::path.plot(synth.res = synth.out, dataprep.res = dataprep.out,
Ylab = "Emploi", Xlab = "year", Legend = c("France", "synthetic France"), Legend.position = "bottomright")
```
#On extrait les poids
```{r}
synth.tables <- Synth::synth.tab(dataprep.res = dataprep.out, synth.res = synth.out)
synth.tables$tab.w
```
#La c'est pour voir comment on fait pour recalculer la France synthétique à partir des résultat brut
```{r}
x=dataprep.out$Y0%*%synth.out$solution.w
u=dataprep.out$Y1
df=data.frame(c(rep("Synthetique",nrow(x)),rep("Reel",nrow(u))),c(x,u))
df2=data.frame(x=(rep((1995:2017),2)),df)
qplot(x=x, y=c.x..u.,color=c.rep..Synthetique...nrow.x....rep..Reel...nrow.u..., data=df2, geom="line")+ xlab("Date")
df2
```
#La c'est le graphique de la diff synthétique-réel
```{r}
qplot(x=c(1995:2017),dataprep.out$Y0%*%synth.out$solution.w-dataprep.out$Y1,geom="line")
```
#On fait une boucle sur les pays (en fait pour l'instant on enlève le premier et le dernier pour des histoires d'indices)
```{r}
quiet <- function(x) {
sink(tempfile())
on.exit(sink())
invisible(force(x))
}
for (i in c(2:12,14:25))
{
#On calcul le contrôle synthétique avec l'unité i traitée
print(i)
a=c(1:(i-1),(i+1):26)
dataprep_i.out=Synth::dataprep(foo=df.melted,
special.predictors = list(list("value.x",1999,"mean"),
list("value.x",2001,"mean"),
list("value.x",2003,"mean"),
list("value.x",2005,"mean"),
list("value.x",2007,"mean"),
list("value.x",2009,"mean"),
list("value.y",1999,"mean"),
list("value.y",2001,"mean"),
list("value.y",2003,"mean"),
list("value.y",2005,"mean"),
list("value.y",2007,"mean"),
list("value.y",2009,"mean")
),
predictors.op = "mean",
time.predictors.prior = 2000:2012,
dependent="value.x",
unit.variable = "index",
unit.names.variable="country",
treatment.identifier = i,
controls.identifier = a[a!=13],
time.variable = 'temps',
time.optimize.ssr = 2000:2012, #
time.plot=1995:2017)
quiet(synth.out_i <- Synth::synth(data.prep.obj = dataprep.out, method = "BFGS")) #On calcul les résultats sans les afficher
if (i==2)
{
#On initialise une base avec en ligne le noms de l'unité puis l'effet du traitement pour chaque année (le numéro de l'année n'est pas dans la base)
noms=c(rep(as.character(i),nrow(x)))
valeur=dataprep_i.out$Y0%*%synth.out_i$solution.w-dataprep_i.out$Y1
df=data.frame(noms,valeur)
couleur=c("red") #ca c'est pour gérer les couleurs
}
if (i>2)
{
#On complète la base
noms=c(noms,rep(as.character(i),nrow(x)))
valeur=c(valeur,dataprep_i.out$Y1-dataprep_i.out$Y0%*%synth.out_i$solution.w)
df=data.frame(noms,valeur)
if (i==17){couleur=c(couleur,"blue")}
else{couleur=c(couleur,"red")}
}
}
df2=data.frame(x=(rep((1995:2017),length(unique(noms)))),df)
```
```{r}
qplot(x=x, y=valeur,color=noms, data=df2, geom="line")+ xlab("Date")+scale_color_manual(breaks = unique(df2$noms), values=couleur)
```
```{r}
```
```{r}
df.melted
```
```{r}
c(2:17)[-13]
```