par Niamh Dunne
Ce guide fait partie d’une série de trois guides sur tresthor :
Nous présentons un exemple simple de prévision macroéconomique pour le Royaume-Uni. Le modèle comporte des équations comportementales1 pour les composantes de la demande, l’emploi, ainsi qu’une boucle inflationniste prix-salaires. Les données proviennent de dbnomics, une plateforme gratuite réunissant une vaste gamme de données économiques fournies par des institutions statistiques nationales et internationales. Elles sont chargées directement via le package rdbnomics.
# Librairies ----------------------------------------------------------------
library(tidyverse)
library(rdbnomics)
library(tresthor)
library(x12)
library(lubridate)
# Noms et codes des series a charger ----------------------------------------
series_dbnomics <- readRDS(system.file("UK_example","series_dbnomics.RDS",package="tresthor"))
Le data.frame series_dbnomics
indique le code dbnomics de la série, le nom de variable souhaité, ainsi que la description des données :
name | series_code | label |
pib | ONS/QNA/ABMI.Q | Gross Domestic Product: chained volume measures: Seasonally adjusted £m – Quarterly |
conso_publique | ONS/QNA/NMRY.Q | General Government: Final consumption expenditure: P3: CVM SA £m – Quarterly |
conso_menages | ONS/QNA/ABJR.Q | Household final consumption expenditure :National concept CVM SA - £m – Quarterly |
conso_isblsm | ONS/QNA/HAYO.Q | Final Consumption Expenditure of NPISHs CVM SA £m – Quarterly |
fbcf | ONS/QNA/NPQT.Q | Total Gross Fixed Capital Formation CVM SA £m – Quarterly |
fbcf_publique | ONS/QNA/DLWF.Q | Gross Fixed Capital Formation:Total General Government P51:CVM SA: £m – Quarterly |
fbcf_logements_menages | ONS/QNA/L636.Q | GFCF:Private sector: TOTAL: Dwellings, excluding land: £m: CVM: SA – Quarterly |
fbcf_transac_menages | ONS/QNA/L637.Q | GFCF:Private sector: TOTAL: Transfer of ownership costs: £m: CVM: SA – Quarterly |
fbcf_logements_entrpub | ONS/QNA/L634.Q | GFCF:Public non-fin corps: TOTAL: Dwellings, excluding land: £m: CVM: SA – Quarterly |
fbcf_transac_entrpub | ONS/QNA/L635.Q | GFCF:Public non-fin corps: TOTAL: Transfer of ownership costs: £m: CVM: SA – Quarterly |
fbcf_entreprises | ONS/QNA/NPEL.Q | Gross Fixed Capital Formation: Business Investment: CVM SA: £m – Quarterly |
exportations | ONS/QNA/IKBK.Q | Total Trade (TT): WW: Exports: BOP: CVM: SA – Quarterly |
importations | ONS/QNA/IKBL.Q | Total Trade (TT): WW: Imports: BOP: CVM: SA – Quarterly |
di | ONS/QNA/YBIM.Q | Total national expenditure (aligned) - P.3+P.5: CVM SA £m – Quarterly |
df | ONS/QNA/ABMG.Q | Total gross final expenditure (aligned) - P.3+P.5+P.6 : CVM SA £m – Quarterly |
solde_exterieur | ONS/QNA/IKBM.Q | Total Trade (TT): WW: Balance: BOP: CVM: SA – Quarterly |
pib_val | ONS/QNA/YBHA.Q | Gross Domestic Product at market prices: Current price: Seasonally adjusted £m – Quarterly |
conso_publique_val | ONS/QNA/NMRP.Q | General Government: Final consumption expenditure (P3): CPSA £m – Quarterly |
conso_menages_val | ONS/QNA/ABJQ.Q | Households (S.14): Individual consumption expenditure (P.31) Uses: Current price: £m: SA – Quarterly |
conso_isblsm_val | ONS/QNA/HAYE.Q | NPISH (S.15): Individual consumption expenditure (P.31): Uses: Current price: £m: SA – Quarterly |
fbcf_val | ONS/QNA/NPQS.Q | Total Gross Fixed Capital Formation CP SA £m – Quarterly |
fbcf_publique_val | ONS/QNA/RPZG.Q | GFCF : S.13 : TOTAL : TOTAL : CP : SA : VALUE : £m : P.51g – Quarterly |
fbcf_logements_menages_val | ONS/QNA/L62T.Q | GFCF:Private sector: TOTAL: Dwellings, excluding land: £m: CP: SA – Quarterly |
fbcf_transac_menages_val | ONS/QNA/L62U.Q | GFCF:Private sector: TOTAL: Transfer of ownership costs: £m: CP: SA – Quarterly |
fbcf_logements_entrpub_val | ONS/QNA/L62R.Q | GFCF:Public non-fin corps: TOTAL: Dwellings, excluding land: £m: CP: SA – Quarterly |
fbcf_transac_entrpub_val | ONS/QNA/L62S.Q | GFCF:Public non-fin corps: TOTAL: Transfer of ownership costs: £m: CP: SA – Quarterly |
fbcf_entreprises_val | ONS/QNA/NPEK.Q | Gross Fixed Capital Formation: Business Investment: CP SA: £m – Quarterly |
exportations_val | ONS/QNA/IKBH.Q | Total Trade (TT): WW: Exports: BOP: CP: SA – Quarterly |
importations_val | ONS/QNA/IKBI.Q | Total Trade (TT): WW: Imports: BOP: CP: SA – Quarterly |
di_val | ONS/QNA/YBIL.Q | Total national expenditure (aligned) - P.3+P.5: CP SA £m – Quarterly |
df_val | ONS/QNA/ABMF.Q | Total gross final expenditure (aligned) - P.3+P.5+P.6 : CP SA £m – Quarterly |
solde_exterieur_val | ONS/QNA/IKBJ.Q | Total Trade (TT): WW: Balance: BOP: CP: SA – Quarterly |
salaires_d1 | ONS/UKEA/DTWN.Q | Households (S.14): Compensation of employees (D.1) Resources: Current price: £m: SA – Quarterly |
rdb | ONS/UKEA/RPHA.Q | Households (S.14): Disposable income, gross (B.6g): Uses/Resources: Current price: £m: SA – Quarterly |
ajust_pension | ONS/UKEA/HAZA.Q | Households (S.14): Adjustment for the change in pension entitlements (D.8) Resources: Current price: £m: NSA – Quarterly |
emploi | ONS/LMS/MGRZ.Q | Number of People in Employment (aged 16 and over, seasonally adjusted) – Quarterly |
emploi_sal | ONS/LMS/MGRN.Q | LFS: Employees: UK: All: Thousands: SA: Annual = 4 quarter average – Quarterly |
chomage | ONS/LMS/MGTP.Q | LFS: ILO unemployed: UK: All: Aged 16 and over: Thousands: NSA – Quarterly |
h_trav | ONS/LMS/YBUS.Q | LFS: Total actual weekly hours worked (millions): UK: All: SA – Quarterly |
ipc_tot | ONS/MM23/D7BT.Q | CPI INDEX 00: ALL ITEMS 2015=100 – Quarterly |
ipc_core | ONS/MM23/DKC6.Q | CPI INDEX: Excluding Energy, food, alcoholic beverages & tobacco 2015=100 – Quarterly |
ipc_nrj | ONS/MM23/DK9T.Q | CPI INDEX: Energy (G) 2015=100 – Quarterly |
w_ipc_core | ONS/MM23/A9FU.A | CPI wts: CPI excluding energy, food, alcohol & tobacco SPECIAL AGGREGATES – Annual |
w_ipc_nrj | ONS/MM23/A9F3.A | CPI wts: Energy GOODS – Annual |
tcen | IMF/IFS/Q.GB.ENEER_IX | Quarterly – United Kingdom – Exchange Rates, Nominal Effective Exchange Rate, Index |
tcer | IMF/IFS/Q.GB.EREER_IX | Quarterly – United Kingdom – Exchange Rates, Real Effective Exchange Rate based on Consumer Price Index, Index |
dm | OECD/EO/GBR.XMKT.Q | United Kingdom – Export market for goods and services, volume in USD – Quarterly |
brent | IMF/WEOAGG:2020-10/001.POILAPSP.us_dollars | World – Crude Oil (petroleum), simple average of three spot prices; Dated Brent, West Texas Intermediate, and the Dubai Fateh, US$ per barrel – U.S. dollars |
usd_gbr | IMF/IFS/Q.GB.EDNA_USD_XDC_RATE | Quarterly – United Kingdom – Exchange Rates, US Dollar per Domestic Currency, Period Average, Rate |
px_immo | OECD/HOUSE_PRICES/Q.GBR.HPI | Quarterly – United Kingdom – Nominal house price indices, s.a. |
Les données sont récupérées avec la fonction rdb()
du package rdbnomics
, avec un data.frame par fréquence, dans l’objet list df.
# Liste de data.frame par frequence, a partir de 1980 ------------------------
df <- rdb(ids=series_dbnomics$series_code) %>%
as.data.frame() %>%
filter(period>=as.Date("1980-01-01")) %>%
unite(col="name",provider_code,dataset_code,series_code,sep="/") %>%
split(.[,"@frequency"]) %>%
lapply(function(x){reshape(x[,c("name","period","value")],
direction="wide",
timevar="name",idvar="period")}) %>%
lapply(function(x){
colnames(x) <- series_dbnomics[gsub("value.","",colnames(x)),"name"]
colnames(x)[1] <- "date"
return(x)})
rm(series_dbnomics)
Il convient à présent d’effectuer des retraitements et calculs pour finir de préparer la base de données2. Nous obtenons in fine une base de données trimestrielle.
##############################################################################
######################## retraitements des donnees ############################
################################################################################
# Fonctions --------------------------------------------------------------------
# Variation trimestrielle
vt <- function(x){
return(x/lag(x,n=1)-1)
}
# Premiere obs non NA
firstNonNA <- function(x){
i <- 1
y <- x[i]
while(is.na(x[i])){
i <- i+1
}
return(i)
}
# Niveau a partir de vt
getLevel <- function(x) {
# Fonction qui prend en input un taux de croissance et retourne un niveau (indice)
# Attention pas de trous dans les donnees, juste des NA au debut et a la fin de la serie, sinon ca ne fonctionne pas.
nobs <- length(na.omit(x))
x[1] <- NA
i <- firstNonNA(x)
y <- c(1,1+na.omit(x))
res <- x
res[(i-1):(i+nobs-1)]<-cumprod(y)
return(res)
}
# Fonction qui repete chaque observation de v times fois
freqconv_repeat <- function(v,times){
n=length(v)
y <- rep(NA,n*times)
for(i in 1:n){
for(j in ((i-1)*times+1):(i*times)){
y[j]<-v[i]
}
}
return(y)
}
# Fonction qui approxime une somme de volumes chaines
AgregVolch <- function(val, volch, annref = 2014){
if (any(!(names(val) %in% names(volch))) | any(!(names(volch) %in% names(val)))) stop("Les noms de variables ne correspondent pas")
val$agreg <- rowSums(val)
for (i in c("val", "volch")){
t <- eval(parse(text = i))
t$annee <- as.numeric(substr(rownames(t), 1, 4))
t.ann <- aggregate(subset(t, select = -c(annee)), by = list(t$annee), FUN = sum)
rownames(t.ann) <- t.ann$Group.1
assign(paste0(i, "_ann"), subset(t.ann, select = -c(Group.1)))
}
prixch_ann <- subset(val_ann, select = -c(agreg)) / volch_ann
volpap <- volch
for (i in 1:dim(volpap)[1]){
volpap[i, ] <- volch[i, ] * prixch_ann[as.character(as.numeric(substr(rownames(subset(volpap, rownames(volpap) == rownames(volpap)[i])), 1, 4)) - 1), ]
}
volpap$agreg <- rowSums(volpap)
volpap$annee <- as.numeric(substr(rownames(volpap), 1, 4))
volpap_ann <- aggregate(subset(volpap, select = -c(annee)), by = list(volpap$annee), FUN = sum)
rownames(volpap_ann) <- volpap_ann$Group.1
volpap_ann <- subset(volpap_ann, select = -c(Group.1))
volch_ann <- val_ann
for (i in (annref + 1):max(as.numeric(rownames(volch_ann)))){
volch_ann[as.character(i), ] <- volch_ann[as.character(i - 1), ] * volpap_ann[as.character(i), ] / val_ann[as.character(i - 1), ]
}
for (i in (annref - 1):(min(as.numeric(rownames(volch_ann))))){
volch_ann[as.character(i), ] <- volch_ann[as.character(i + 1), ] / volpap_ann[as.character(i + 1), ] * val_ann[as.character(i), ]
}
prixch_ann$agreg <- val_ann$agreg / volch_ann$agreg
for (i in 1:dim(volch)[1]){
volch[i, "agreg"] <- volpap[i, "agreg"] / prixch_ann[as.character(as.numeric(substr(rownames(subset(volpap, rownames(volpap) == rownames(volpap)[i])), 1, 4)) - 1), "agreg"]
}
return(subset(volch, select = c(agreg)))
}
# Trimestrialisation -----------------------------------------------------------
# 1 seul data.frame trimestriel (repeter l'annuel)
df_q <- lapply(df[["annual"]][,-1],freqconv_repeat,times=4) %>%
as.data.frame(.) %>%
mutate(.,date=seq.Date(from=as.Date("1980-01-01"),by="quarter",length.out=nrow(.))) %>%
merge(.,df[["quarterly"]],all=TRUE)
rm(df)
# Nom des lignes
rownames(df_q) <- df_q$date
# Corriger de la saisonnalite --------------------------------------------------
# ipc_core
name_x <- "ipc_core"
name_y <- "ipc_core"
x <- ts(df_q[,name_x],start=year(df_q$date[1]),frequency=4)
y <- x12(x)@d11
y[is.na(x)] <- NA
df_q[,name_y] <- as.vector(y)
# ipc_nrj
name_x <- "ipc_nrj"
name_y <- "ipc_nrj"
x <- ts(df_q[,name_x],start=year(df_q$date[1]),frequency=4)
y <- x12(x)@d11
y[is.na(x)] <- NA
df_q[,name_y] <- as.vector(y)
# ipc_tot
name_x <- "ipc_tot"
name_y <- "ipc_tot"
x <- ts(df_q[,name_x],start=year(df_q$date[1]),frequency=4)
y <- x12(x)@d11
y[is.na(x)] <- NA
df_q[,name_y] <- as.vector(y)
# Suppression des fichiers x12
fichiers_x12_a_supprimer <- list.files(pattern = ("^Rout.*"))
if (length(fichiers_x12_a_supprimer) > 0) {
fichiers_x12_a_supprimer %>% purrr::map(~file.remove(.x))
}
dossier_x12_a_supprimer <- list.files(pattern = ("^gra_Rout$"))
unlink(dossier_x12_a_supprimer, recursive = TRUE)
rm(name_x,name_y,x,y,dossier_x12_a_supprimer,fichiers_x12_a_supprimer)
### Modif 2005T2 ---------------------------------------------------------------
# On observe sur le passe un flux negatif de fbcf publique en 2005Q2, compense par un
# flux positif de fbcf entreprises.
# On modifie cela pour ne pas perturber l'estimation (log de negatif impossible).
# Interpolation lineaire 2005Q2 pour la fbcf_entreprises.
temp1 <- df_q["2005-04-01","fbcf_entreprises"]
temp2 <- df_q["2005-01-01","fbcf_entreprises"]
temp3 <- df_q["2005-07-01","fbcf_entreprises"]
temp4 <- (temp2+temp3)/2 - temp1 # interpolation moins observe (negatif)
# On retire la difference de la fbcf_eq et on l'ajoute a la fbcf_apu.
temp5 <- df_q["2005-04-01","fbcf_publique"]
df_q["2005-04-01","fbcf_entreprises"] <- temp1 + temp4
df_q["2005-04-01","fbcf_publique"] <- temp5 - temp4
# Idem valeur
# Interpolation lineaire 2005Q2 pour la fbcf_entreprises.
temp1 <- df_q["2005-04-01","fbcf_entreprises_val"]
temp2 <- df_q["2005-01-01","fbcf_entreprises_val"]
temp3 <- df_q["2005-07-01","fbcf_entreprises_val"]
temp4 <- (temp2+temp3)/2 - temp1 # interpolation moins observe (negatif)
# On retire la difference de la fbcf_eq et on l'ajoute a la fbcf_apu.
temp5 <- df_q["2005-04-01","fbcf_publique_val"]
df_q["2005-04-01","fbcf_entreprises_val"] <- temp1 + temp4
df_q["2005-04-01","fbcf_publique_val"] <- temp5 - temp4
rm(temp1,temp2,temp3,temp4,temp5)
### Operations sur volumes chaines ---------------------------------------------
### ### Calcul fbcf menages ----------------------------------------------------
# A modifier
series <- c("fbcf_logements_menages",
"fbcf_transac_menages",
"fbcf_logements_entrpub",
"fbcf_transac_entrpub")
resultat <- "fbcf_menages"
# A ne pas modifier
series_val <- paste0(series,"_val")
resultat_val <- paste0(resultat,"_val")
volch <- df_q[,series]
val <- df_q[,series_val]
colnames(val) <- series
df_q[,resultat]<- AgregVolch(volch=volch,val=val,annref=2018)$agreg
df_q[,resultat_val] <- rowSums(val)
rm(volch,val,series,series_val,resultat,resultat_val)
### ### Calcul consommation privee ---------------------------------------------
# A modifier
series <- c("conso_menages",
"conso_isblsm")
resultat <- "conso_privee"
# A ne pas modifier
series_val <- paste0(series,"_val")
resultat_val <- paste0(resultat,"_val")
volch <- df_q[,series]
val <- df_q[,series_val]
colnames(val) <- series
df_q[,resultat]<- AgregVolch(volch=volch,val=val,annref=2018)$agreg
df_q[,resultat_val] <- rowSums(val)
rm(volch,val,series,series_val,resultat,resultat_val)
### ### Calcul dihs ------------------------------------------------------------
# A modifier
series <- c("conso_privee",
"conso_publique",
"fbcf")
resultat <- "dihs"
# A ne pas modifier
series_val <- paste0(series,"_val")
resultat_val <- paste0(resultat,"_val")
volch <- df_q[,series]
val <- df_q[,series_val]
colnames(val) <- series
df_q[,resultat]<- AgregVolch(volch=volch,val=val,annref=2018)$agreg
df_q[,resultat_val] <- rowSums(val)
rm(volch,val,series,series_val,resultat,resultat_val)
### Calcul des deflateurs ------------------------------------------------------
series <- c(
"pib",
"conso_publique",
"conso_privee",
"fbcf",
"fbcf_publique",
"fbcf_menages",
"fbcf_entreprises",
"exportations",
"importations",
"conso_menages"
)
for (i in series){
df_q[,paste0("defl_",i)]<-df_q[,paste0(i,"_val")]/df_q[,i]*100
}
rm(series,i)
### Calcul des contributions au PIB --------------------------------------------
series <- c("conso_privee","conso_publique","fbcf","fbcf_publique",
"fbcf_menages","fbcf_entreprises","exportations","importations")
for (s in series){
if (s=="importations"){m<--1}else{m<-1}
x <- df_q[,s]
xval <- df_q[,paste0(s,"_val")]
df_q[,paste0("contrib_",s)] <- vt(x)*.5*(xval/df_q$pib_val+lag(xval,n=1)/lag(df_q$pib_val,n=1))*m
}
df_q$contrib_solde_exterieur <- with(df_q,contrib_exportations+contrib_importations)
df_q$contrib_dihs <- with(df_q,contrib_conso_privee+contrib_conso_publique+contrib_fbcf)
df_q$contrib_di <- with(df_q,vt(pib)-contrib_solde_exterieur)
df_q$contrib_vstockserr <- with(df_q,contrib_di-contrib_dihs)
df_q$contrib_df <- with(df_q,contrib_di+contrib_exportations)
rm(s,series,m)
### Stocks en niveau -----------------------------------------------------------
df_q$vstockserr_val <- with(df_q,pib_val-conso_privee_val-conso_publique_val-fbcf_val-exportations_val+importations_val)
### Compte des menages ---------------------------------------------------------
# Pouvoir d'achat
df_q$pa <- with(df_q,rdb/defl_conso_privee*100)
# df_q$pa_deflipc <- with(df_q,rdb/ipc_tot*100) #deflate par l'IPC
# Epargne
df_q$epargne <- with(df_q,rdb+ajust_pension-conso_menages_val)
df_q$tx_epargne <- with(df_q,epargne/(rdb+ajust_pension))
### Marche du travail ----------------------------------------------------------
# Heures travaillees par emploi
df_q$h_trav_pemp <- with(df_q,h_trav/emploi*10^(6-3))
# Population active et taux d'activite
df_q$popact <- with(df_q,emploi+chomage)
# Taux de chomage
df_q$tx_chomage<-with(df_q,chomage/popact)
### Prix-couts -----------------------------------------------------------------
# Contributions a l'inflation totale
df_q$w_ipc_tot=1000
df_q$w_ipc_alim <- with(df_q,w_ipc_tot-w_ipc_core-w_ipc_nrj)
df_q$contrib_ipc_nrj <- with(df_q,vt(ipc_nrj)*lag(w_ipc_nrj,n=1)/1000)
df_q$contrib_ipc_core <- with(df_q,vt(ipc_core)*lag(w_ipc_core,n=1)/1000)
# Calcul IPC alim (solde des contributions)
df_q$contrib_ipc_alim <- with(df_q,vt(ipc_tot) - (contrib_ipc_nrj + contrib_ipc_core))
df_q$ipc_alim_vt <- with(df_q,contrib_ipc_alim/(w_ipc_alim/1000))
df_q$ipc_alim <- with(df_q,getLevel(ipc_alim_vt))
df_q$ipc_alim <- with(df_q,ipc_alim/mean(ipc_alim[which(year(df_q$date)==2015)])*100) # Base 2015=100
# SMPT
df_q$smpt_d1 <- with(df_q,salaires_d1/emploi_sal)
# Productivite
df_q$productivite <- with(df_q,pib/emploi)
# CSU
df_q$csu_d1 <- with(df_q,smpt_d1/productivite)
# Taux de marge macro
df_q$tx_marge_macro <- with(df_q,(pib_val-salaires_d1)/pib_val)
# Taux d'investissement macro
df_q$tx_investissement_macro <- with(df_q,fbcf_val/pib_val)
# Brent en GBR
df_q$brentl <- with(df_q,brent/usd_gbr)
# Prix immo reels
df_q$px_immo_rimmo <- with(df_q,px_immo/defl_fbcf_menages*100)
### Variation trimestrielle du pib et de l'inflation ---------------------------
df_q$pib_vt <- vt(df_q$pib)
df_q$ipc_tot_vt <- vt(df_q$ipc_tot)
Pour mener à bien notre exemple de prévision pour les années 2019 et 2020, nous faisons comme si notre base de donnée s’arrêtait au dernier trimestre de 2018. Nous commençons par prolonger le data.frame jusqu’au dernier trimestre 2020.
### Exemple de prevision pour 2019 et 2020 ----------------------------------
### Supprimer donnees apres 2018 (pour faire un exemple de prevision) -------
df_q <- df_q[which(df_q$date<=as.Date("2018-10-01")),]
### Prolongation des series exogenes ----------------------------------------
date_fin_obs <- "2018-10-01"
date_debut_prev <- "2019-01-01"
date_fin_prev <- "2020-10-01"
horizon_prev <- seq.Date(from=as.Date(date_debut_prev),
to=as.Date(date_fin_prev),
by="quarter") %>%
as.character(.)
### ### Extension du data.frame jusqu'à fin 2020 -----------------------------
while(last(df_q$date)<as.Date(date_fin_prev)){
temp <- df_q[nrow(df_q),]
temp <- lapply(temp,function(x)x<-NA) %>% as.data.frame(.)
temp$date <- ceiling_date(as.Date(last(df_q$date)), "quarter")
rownames(temp) <- temp$date
df_q <- rbind(df_q,temp)
}
rm(temp)
A titre d’exemple, nous prolongeons les séries exogènes en prévision, soit en les gelant, soit en les faisant croître selon leur rythme de croissance moyen sur les deux dernières années. Nous déclarons également les séries annexes (tendance et indicatrices) une fois le data.frame étendu.
### ### gel -----------------------------------------------------------------
series <- c("tcen","tcer","w_ipc_tot","w_ipc_core","w_ipc_nrj","w_ipc_alim",
"ajust_pension","brentl","usd_gbr","h_trav_pemp")
df_q[horizon_prev,series] <- df_q[date_fin_obs,series]
### ### contribution variation des stocks et erreurs nulle ------------------
df_q[horizon_prev,"contrib_vstockserr"] <- 0
### ### croissance moyenne --------------------------------------------------
series <- c("dm","conso_publique_val","fbcf_publique_val",
"defl_conso_publique","defl_fbcf_publique","px_immo",
"popact","defl_importations","defl_exportations")
horizon_prev_index <- which(rownames(df_q)%in%horizon_prev)
n0=horizon_prev_index[1]-8
n1=horizon_prev_index[1]-1
for (s in series){
x0 <- df_q[n0,s]
x1 <- df_q[n1,s]
var <- (x1/x0)^(1/(n1-n0))-1
for(h in horizon_prev_index){
df_q[h,s] <- df_q[h-1,s]*(1+var)
}
}
rm(series,n1,n0)
### ### Autres series -------------------------------------------------------
# Indicatrices
df_q$dummy06q1 <- 0
df_q$dummy06q1[which(df_q$date==as.Date("2006-01-01"))] <- 1
df_q$dummy06q2 <- 0
df_q$dummy06q2[which(df_q$date==as.Date("2006-04-01"))] <- 1
df_q$dummy06q3 <- 0
df_q$dummy06q3[which(df_q$date==as.Date("2006-07-01"))] <- 1
df_q$dummy09q2<-0
df_q$dummy09q2[which(df_q$date==as.Date("2009-04-01"))]<-1
# Tendance
df_q$tendance <- 1:nrow(df_q)
Commençons par lire le modèle, écrit dans un fichier txt.
# Lecture du modele ---------------------------------------------------------
create_model("exemple_mod",model_source=system.file("UK_example","UK_model.txt",package="tresthor"))
Le modèle du fichier .txt décrit les relations existant entre les variables et les hypothèses faites en prévision, via des équations comportementales et des identités. Il distingue les variables exogènes, endogènes, ainsi que les coefficients. Les équations peuvent avoir un nom en début de ligne, avant le signe “:”. Nous utilisons le modèle suivant :
endo:
af_eq_ipc_alim,af_eq_ipc_nrj,af_eq_ipc_core,af_eq_emploi,af_eq_smpt_d1,af_eq_conso_privee,af_eq_fbcf_entreprises,af_eq_fbcf_menages,af_eq_importations,af_eq_exportations,af_eq_rdb,conso_privee,fbcf_menages,fbcf_entreprises,exportations,importations,pib_vt,pib,fbcf,dihs,di,df,conso_menages,pib_val,conso_privee_val,fbcf_val,fbcf_menages_val,fbcf_entreprises_val,exportations_val,importations_val,vstockserr_val,dihs_val,di_val,df_val,conso_menages_val,contrib_conso_privee,contrib_conso_publique,contrib_fbcf,contrib_fbcf_publique,contrib_fbcf_entreprises,contrib_fbcf_menages,contrib_exportations,contrib_importations,contrib_dihs,contrib_di,contrib_solde_exterieur,contrib_df,ipc_alim,ipc_nrj,ipc_core,contrib_ipc_alim,contrib_ipc_nrj,contrib_ipc_core,ipc_tot_vt,ipc_tot,smpt_d1,csu_d1,productivite,defl_fbcf_menages,defl_fbcf_entreprises,defl_conso_privee,defl_conso_menages,emploi,chomage,tx_chomage,emploi_sal,px_immo_rimmo,salaires_d1,rdb,epargne,tx_epargne,pa,conso_publique,fbcf_publique,defl_pib,tx_marge_macro,tx_investissement_macro
####DO NOT ADD BLANK LINES OR REMOVE THIS LINE##############################
exo:
afusr_eq_ipc_alim,afusr_eq_ipc_nrj,afusr_eq_ipc_core,afusr_eq_emploi,afusr_eq_smpt_d1,afusr_eq_conso_privee,afusr_eq_fbcf_entreprises,afusr_eq_fbcf_menages,afusr_eq_importations,afusr_eq_exportations,afusr_eq_rdb,tcer,tcen,contrib_vstockserr,fbcf_publique_val,conso_publique_val,brentl,w_ipc_alim,w_ipc_nrj,w_ipc_core,w_ipc_tot,defl_importations,defl_exportations,h_trav_pemp,popact,px_immo,ajust_pension,tendance,dummy06q1,dummy06q3,dm,defl_conso_publique,defl_fbcf_publique
####DO NOT ADD BLANK LINES OR REMOVE THIS LINE##############################
coeff:
e_cst,e_0,e_lt1,e_lt2,e_1,e_2,i_cst,i_0,i_lt1,i_lt2,i_lt3,i_1,i_2,j_cst,j_0,j_1,f_cst,f_0,f_1,f_2,f_3,f_4,g_cst,g_0,g_lt1,g_lt2,g_lt3,g_1,a_cst,a_0,a_lt1,a_lt2,a_lt3,b_cst,b_0,b_lt1,b_lt2,b_1,c_cst,c_0,c_lt1,c_lt2,c_lt3,c_1,c_2,h_cst,h_0,h_1,d_cst,d_0,d_1,d_2,d_3,k_0
####DO NOT ADD BLANK LINES OR REMOVE THIS LINE##############################
equations:
af_eq_ipc_alim=lag(af_eq_ipc_alim,-1)+afusr_eq_ipc_alim
af_eq_ipc_nrj=lag(af_eq_ipc_nrj,-1)+afusr_eq_ipc_nrj
af_eq_ipc_core=lag(af_eq_ipc_core,-1)+afusr_eq_ipc_core
af_eq_emploi=lag(af_eq_emploi,-1)+afusr_eq_emploi
af_eq_smpt_d1=lag(af_eq_smpt_d1,-1)+afusr_eq_smpt_d1
af_eq_conso_privee=lag(af_eq_conso_privee,-1)+afusr_eq_conso_privee
af_eq_fbcf_entreprises=lag(af_eq_fbcf_entreprises,-1)+afusr_eq_fbcf_entreprises
af_eq_fbcf_menages=lag(af_eq_fbcf_menages,-1)+afusr_eq_fbcf_menages
af_eq_importations=lag(af_eq_importations,-1)+afusr_eq_importations
af_eq_exportations=lag(af_eq_exportations,-1)+afusr_eq_exportations
af_eq_rdb=lag(af_eq_rdb,-1)+afusr_eq_rdb
eq_conso_privee:delta(1,log(conso_privee))=e_cst+e_0*(log(lag(conso_privee,-1))-e_lt1-e_lt2*log(lag(pa,-1)))+e_1*delta(1,log(pa))+e_2*delta(1,log(emploi))+delta(1,af_eq_conso_privee)-e_0*lag(af_eq_conso_privee,-1)
eq_fbcf_menages:delta(1,log(fbcf_menages))=i_cst+i_0*(log(lag(fbcf_menages,-1))-i_lt1-i_lt2*log(lag(px_immo_rimmo,-1))-i_lt3*tendance)+i_1*delta(1,log(px_immo_rimmo))+i_2*delta(1,log(pib))+delta(1,af_eq_fbcf_menages)-i_0*lag(af_eq_fbcf_menages,-1)
eq_fbcf_entreprises:delta(1,log(fbcf_entreprises))=j_cst+j_0*(log(lag(fbcf_entreprises,-1))-1*log(lag(pib,-1)))+j_1*delta(1,log(pib))+delta(1,af_eq_fbcf_entreprises)-j_0*lag(af_eq_fbcf_entreprises,-1)
eq_exportations:delta(1,log(exportations))=f_cst+f_0*log(lag(exportations,-1))+f_1*log(lag(dm,-1))+f_2*delta(1,log(dm))+f_3*dummy06q1+f_4*dummy06q3+delta(1,af_eq_exportations)-f_0*lag(af_eq_exportations,-1)
eq_importations:delta(1,log(importations))=g_cst+g_0*(log(lag(importations,-1))-g_lt1-g_lt2*log(lag(df,-1))-g_lt3*log(lag(tcen,-1)))+g_1*delta(1,log(df))+delta(1,af_eq_importations)-g_0*lag(af_eq_importations,-1)
pib_vt=contrib_conso_privee+contrib_conso_publique+contrib_exportations+contrib_importations+contrib_fbcf+contrib_vstockserr
pib=lag(pib,-1)*(pib_vt+1)
fbcf=lag(fbcf,-1)*(((fbcf_menages/lag(fbcf_menages,-1)-1)*lag(fbcf_menages_val,-1)+(fbcf_entreprises/lag(fbcf_entreprises,-1)-1)*lag(fbcf_entreprises_val,-1)+(fbcf_publique/lag(fbcf_publique,-1)-1)*lag(fbcf_publique_val,-1))/lag(fbcf_val,-1)+1)
dihs=lag(dihs,-1)*(((conso_privee/lag(conso_privee,-1)-1)*lag(conso_privee_val,-1)+(conso_publique/lag(conso_publique,-1)-1)*lag(conso_publique_val,-1)+(fbcf/lag(fbcf,-1)-1)*lag(fbcf_val,-1))/lag(dihs_val,-1)+1)
di=(contrib_di/(lag(di_val,-1)/lag(pib_val,-1))+1)*lag(di,-1)
df=lag(df,-1)*(((di/lag(di,-1)-1)*lag(di_val,-1)+(exportations/lag(exportations,-1)-1)*lag(exportations_val,-1))/lag(df_val,-1)+1)
conso_menages/lag(conso_menages,-1)=conso_privee/lag(conso_privee,-1)
pib_val=conso_privee_val+conso_publique_val+fbcf_publique_val+fbcf_entreprises_val+fbcf_menages_val+exportations_val-importations_val+vstockserr_val
conso_privee_val=conso_privee*defl_conso_privee/100
fbcf_val=fbcf_publique_val+fbcf_menages_val+fbcf_entreprises_val
fbcf_menages_val=fbcf_menages*defl_fbcf_menages/100
fbcf_entreprises_val=fbcf_entreprises*defl_fbcf_entreprises/100
exportations_val=exportations*defl_exportations/100
importations_val=importations*defl_importations/100
vstockserr_val=(contrib_vstockserr*lag(pib_val,-1)+lag(vstockserr_val,-1))
dihs_val=conso_privee_val+conso_publique_val+fbcf_val
di_val=dihs_val+vstockserr_val
df_val=di_val+exportations
conso_menages_val=conso_menages*defl_conso_menages/100
contrib_conso_privee=(conso_privee/lag(conso_privee,-1)-1)*(lag(conso_privee_val,-1)/lag(pib_val,-1))
contrib_conso_publique=(conso_publique/lag(conso_publique,-1)-1)*(lag(conso_publique_val,-1)/lag(pib_val,-1))
contrib_fbcf=contrib_fbcf_entreprises+contrib_fbcf_menages+contrib_fbcf_publique
contrib_fbcf_publique=(fbcf_publique/lag(fbcf_publique,-1)-1)*(lag(fbcf_publique_val,-1)/lag(pib_val,-1))
contrib_fbcf_entreprises=(fbcf_entreprises/lag(fbcf_entreprises,-1)-1)*(lag(fbcf_entreprises_val,-1)/lag(pib_val,-1))
contrib_fbcf_menages=(fbcf_menages/lag(fbcf_menages,-1)-1)*(lag(fbcf_menages_val,-1)/lag(pib_val,-1))
contrib_exportations=(exportations/lag(exportations,-1)-1)*(lag(exportations_val,-1)/lag(pib_val,-1))
contrib_importations=-(importations/lag(importations,-1)-1)*(lag(importations_val,-1)/lag(pib_val,-1))
contrib_dihs=contrib_conso_privee+contrib_conso_publique+contrib_fbcf
contrib_di=contrib_dihs+contrib_vstockserr
contrib_solde_exterieur=contrib_exportations+contrib_importations
contrib_df=contrib_di+contrib_exportations
eq_ipc_alim:delta(1,log(ipc_alim))=a_cst+a_0*(log(lag(ipc_alim,-1))-a_lt1-a_lt2*log(lag(brentl,-1))-a_lt3*log(lag(tcen,-1)))+delta(1,af_eq_ipc_alim)-a_0*lag(af_eq_ipc_alim,-1)
eq_ipc_nrj:delta(1,log(ipc_nrj))=b_cst+b_0*(log(lag(ipc_nrj,-1))-b_lt1-b_lt2*log(lag(brentl,-1)))+b_1*delta(1,log(brentl))+delta(1,af_eq_ipc_nrj)-b_0*lag(af_eq_ipc_nrj,-1)
eq_ipc_core:delta(1,log(ipc_core))=c_cst+c_0*(log(lag(ipc_core,-1))-c_lt1-c_lt2*log(lag(csu_d1,-1))-c_lt3*log(lag(defl_importations,-1)))+c_1*delta(1,log(lag(ipc_core,-1)))+c_2*delta(1,log(ipc_nrj))+delta(1,af_eq_ipc_core)-c_0*lag(af_eq_ipc_core,-1)-c_1*delta(1,lag(af_eq_ipc_core,-1))
contrib_ipc_alim=(ipc_alim/lag(ipc_alim,-1)-1)*lag(w_ipc_alim,-1)/lag(w_ipc_tot,-1)
contrib_ipc_nrj=(ipc_nrj/lag(ipc_nrj,-1)-1)*lag(w_ipc_nrj,-1)/lag(w_ipc_tot,-1)
contrib_ipc_core=(ipc_core/lag(ipc_core,-1)-1)*lag(w_ipc_core,-1)/lag(w_ipc_tot,-1)
ipc_tot_vt=contrib_ipc_alim+contrib_ipc_nrj+contrib_ipc_core
ipc_tot=lag(ipc_tot,-1)*(1+ipc_tot_vt)
eq_smpt_d1:delta(1,log(smpt_d1))=h_cst+h_0*(log(lag(smpt_d1,-1))-1*log(lag(defl_conso_privee,-1)))+h_1*delta(1,log(productivite))+delta(1,af_eq_smpt_d1)-h_0*lag(af_eq_smpt_d1,-1)
csu_d1=smpt_d1/productivite
productivite=pib/emploi
px_immo_rimmo=px_immo/defl_fbcf_menages*100
defl_fbcf_menages=lag(defl_fbcf_menages,-1)*(px_immo/lag(px_immo,-1))
defl_fbcf_entreprises=lag(defl_fbcf_entreprises,-1)*(1+ipc_tot_vt)
defl_conso_privee=lag(defl_conso_privee,-1)*(1+ipc_tot_vt)
defl_conso_menages=lag(defl_conso_menages,-1)*(1+ipc_tot_vt)
eq_emploi:delta(1,log(emploi))=d_cst+d_0*log(lag(emploi,-1))+d_1*log(lag(pib,-1))+d_2*log(lag(h_trav_pemp,-1))+d_3*delta(1,log(pib))+delta(1,af_eq_emploi)-d_0*lag(af_eq_emploi,-1)
chomage=popact-emploi
tx_chomage=chomage/popact
emploi_sal/lag(emploi_sal,-1)=emploi/lag(emploi,-1)
salaires_d1=smpt_d1*emploi_sal
eq_rdb:delta(1,log(rdb))=k_0*delta(1,log(salaires_d1))+delta(1,af_eq_rdb)
epargne=rdb+ajust_pension-conso_menages_val
tx_epargne=epargne/(rdb+ajust_pension)
pa=rdb/defl_conso_privee*100
conso_publique=conso_publique_val/defl_conso_publique*100
fbcf_publique=fbcf_publique_val/defl_fbcf_publique*100
defl_pib=pib_val/pib*100
tx_marge_macro=(pib_val-salaires_d1)/pib_val
tx_investissement_macro=fbcf_val/pib_val
Le package tresthor permet d’estimer des équations via les MCO, ainsi que des équations à correction d’erreur selon la méthode 2-step, sous certaines conditions :
info_equations
:
endogenous_name
), du résidu en niveau (residual_name
), la date de début d’estimation (estim_start
), de fin d’estimation (estim_end
), la présence d’une constante dans la relation de court-terme (const
), et, si l’équation est de type 2-step, les coefficients du long-terme (coeff_lt
).A l’issue de la fonction quick_estim_all()
, les coefficients sont ajoutés comme variables à la base de données, et les objets thoR.equation
sont créés dans l’environnement global. Des résultats d’estimation complets apparaissent dans la console.
Notez que cet outil d’estimation est proposé pour faciliter l’utilisation du solveur, mais que les coefficients peuvent être inscrits en dur dans le modèle ou directement déclarés dans la base de données si une procédure économétrique davantage sophistiquée est nécessaire.
# Informations sur les equations a estimer ----------------------------------
# A remplir par l'utilisateur :
info_equations <- list(
eq_conso_privee=
list(endogenous_name="conso_privee",
residual_name="af_eq_conso_privee",
coeff_lt=c("e_lt1","e_lt2"),
estim_start=as.Date("2000-01-01"),
estim_end=as.Date("2016-10-01"),
const=TRUE),
eq_fbcf_menages=
list(endogenous_name="fbcf_menages",
residual_name="af_eq_fbcf_menages",
coeff_lt=c("i_lt1","i_lt2","i_lt3"),
estim_start=as.Date("2000-01-01"),
estim_end=as.Date("2016-10-01"),
const=TRUE),
eq_fbcf_entreprises=
list(endogenous_name="fbcf_entreprises",
residual_name="af_eq_fbcf_entreprises",
coeff_lt=NULL,
estim_start=as.Date("2000-01-01"),
estim_end=as.Date("2016-10-01"),
const=TRUE),
eq_importations=
list(endogenous_name="importations",
residual_name="af_eq_importations",