par Niamh Dunne

Ce guide fait partie d’une série de trois guides sur tresthor :

Le guide de l’utilisateur présente en détail l’ensemble des fonctionnalités du package.

Le guide d’utilisation du modèle Opale en R par tresthor.

Le guide appliqué de prévision par tresthor avec un modèle simplifié sur le Royaume-Uni.

Nous présentons un exemple simple de prévision macroéconomique pour le Royaume-Uni. Le modèle comporte des équations comportementales¹ 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.

1 Chargement des données utilisées pour la prévision

# 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ées². 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)

2 Prévision des variables exogènes

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)

3 Chargement du modèle et estimation des équations comportementales

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 :

Les résidus en niveau (qui doivent apparaître explicitement à la fin de l’équation) doivent être nuls dans la base de données ;
Un coefficient ne doit apparaître qu’une seule fois (exception faite de l’expression du résidu en niveau) ;
Il ne doit pas y avoir d’opération sur les coefficients ou sur les variables.
Des informations doivent être fournies par l’utilisateur dans la list info_equations :
- Pour chaque équation, il faut une list de niveau 2 du même nom ;
- Cette dernière doit préciser le nom de l’endogène (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",       
         coeff_lt=c("g_lt1","g_lt2","g_lt3"),   
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_exportations=
    list(endogenous_name="exportations",       
         residual_name="af_eq_exportations",       
         coeff_lt=NULL,                         
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_ipc_alim=
    list(endogenous_name="ipc_alim",           
         residual_name="af_eq_ipc_alim",           
         coeff_lt=c("a_lt1","a_lt2","a_lt3"),   
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_ipc_nrj=
    list(endogenous_name="ipc_nrj",            
         residual_name="af_eq_ipc_nrj",            
         coeff_lt=c("b_lt1","b_lt2"),           
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_ipc_core =
    list(endogenous_name="ipc_core",           
         residual_name="af_eq_ipc_core",           
         coeff_lt=c("c_lt1","c_lt2","c_lt3"),   
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_smpt_d1=
    list(endogenous_name="smpt_d1",            
         residual_name="af_eq_smpt_d1",            
         coeff_lt=NULL,                         
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_emploi=
    list(endogenous_name="emploi",             
         residual_name="af_eq_emploi",             
         coeff_lt=NULL,                         
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=TRUE),
  eq_rdb=
    list(endogenous_name="rdb",                
         residual_name="af_eq_rdb",                
         coeff_lt=NULL,                         
         estim_start=as.Date("2000-01-01"),     
         estim_end=as.Date("2016-10-01"),      
         const=FALSE)
)


# Initialisation des cales dans la bdd --------------------------------------
for(i in info_equations){
  df_q[,i[["residual_name"]]] <- 0
}

# Estimation des equations (coefficients dans la bdd) et creation -----------
# des objets thoR.equation --------------------------------------------------

df_q <- quick_estim_all(info_equations,exemple_mod,df_q,"date")

Il reste à calculer les résidus en niveau sur le passé (dans cet exemple, nous les calculons à partir de l’année 2000) en utilisant la fonction simulate_equation() qui résout l’équation sur le passé avec le résidu comme variable endogène.

Pour notre exemple de scénario baseline, nous indiquons que la contribution des résidus à la croissance des endogènes est nulle en prévision.

# Calcul des residus sur le passe -------------------------------------------

df_q <- lapply(names(info_equations),function(x) {
  y <- simulate_equation(
    thor_equation=get(x),
    database=df_q,
    start_sim=as.Date("2000-01-01"),
    end_sim=as.Date(date_fin_obs),
    index_time="date",
    residual_var=info_equations[[x]]$residual_name) %>%
    as.data.frame() %>%
    .[,c("date","residual")]
  colnames(y) <- c("date",info_equations[[x]]$residual_name)
  return(y)}
) %>%
  Reduce(function(...) merge(..., all=TRUE),.,
         df_q[,which(!colnames(df_q)%in%lapply(info_equations, 
                                               function(x) x$residual_name))])

# Contribution des cales (nulles en prevision dans le scenario baseline) ----
df_q[,paste0("afusr_",names(info_equations))] <- 0

4 Résolution du modèle en prévision

La base de données est prête, le modèle n’a plus qu’à être résolu en prévision. On note que dans cet exemple, nous supposons que les résidus et variables exogènes ne varient pas. Le travail du prévionniste en temps normal consisterait en partie à formuler des hypothèses sur ceux-ci afin d’orienter la prévision par le modèle macroéconomique.

# Resolution du modele en prevision -----------------------------------------

my_prev <- thor_solver(model=exemple_mod,
                       first_period=as.Date(date_debut_prev),
                       last_period=as.Date(date_fin_prev),
                       database=df_q)

Les résultats de la prévision sont contenus dans le data.frame my_prev (identique au data.frame df_q avec en plus la prévision sur l’horizon 2019-20). La variation trimestrielle des variables principales est présentée dans le tableau infra. Pour rappel, notre prévision commence en 2019.

series <- c("pib",
            "conso_publique","conso_privee",
            "fbcf","fbcf_publique","fbcf_entreprises","fbcf_menages",
            "importations","exportations",
            "salaires_d1","pa","ipc_tot","ipc_core",
            "productivite","csu_d1")

labels <- c("PIB","Consommation publique","Consommation privée",
            "FBCF","..... publique",".... entreprises", "..... ménages",
            "Importations","Exportations",
            "Salaires","Pouvoir d'achat","IPC","..... sous-jacent",
            "Productivité","Coûts salariaux unitaires")

# data.frame pour le tableau

df_tableau <- my_prev[,-1] %>%
  lapply(function(x)vt(x)*100) %>%
  as.data.frame() %>%
  .[(nrow(df_q)-4*4+1):nrow(df_q),series] %>%
  t() %>%
  as.data.frame() %>%
  round(digits=1) %>%
  format(decimal.mark = ",",
         digits = 1)
  
rownames(df_tableau) <- labels
df_tableau <- rownames_to_column(df_tableau)  

# Dates

header_annee <- c("",year(my_prev$date[(nrow(df_q)-4*4+1):nrow(df_q)])) %>% as.list()
names(header_annee) <- colnames(df_tableau)  

header_trimestre <- c("",paste0("T",(month(my_prev$date[(nrow(df_q)-4*4+1):nrow(df_q)])-1)/12*4+1)) %>% as.list()
names(header_trimestre) <- colnames(df_tableau)  

# Tableau flextable

df_tableau %>%
  flextable() %>%
  set_header_labels(values=header_trimestre) %>%
  add_header(values=header_annee) %>%
  merge_h(part="header") %>%
  theme_zebra() %>%
  align(align="center",j=2:ncol(df_tableau),part="all")

	2017				2018				2019				2020
	T1	T2	T3	T4	T1	T2	T3	T4	T1	T2	T3	T4	T1	T2	T3	T4
PIB	0,5	0,3	0,4	0,4	0,1	0,4	0,6	0,2	0,4	0,4	0,4	0,3	0,3	0,3	0,3	0,3
Consommation publique	0,1	0,3	0,4	0,2	-0,2	-0,2	0,5	1,4	0,3	0,3	0,3	0,3	0,3	0,3	0,3	0,3
Consommation privée	0,1	-0,1	0,3	0,4	0,4	0,2	0,5	0,6	0,3	0,2	0,2	0,2	0,2	0,1	0,1	0,1
FBCF	0,6	1,9	-0,1	1,4	-1,3	0,1	0,4	-0,2	0,3	0,3	0,2	0,2	0,2	0,2	0,2	0,1
..... publique	-1,4	6,3	-2,1	1,2	-0,2	-0,4	2,5	-2,5	0,6	0,6	0,6	0,6	0,6	0,6	0,6	0,6
.... entreprises	2,3	0,4	-0,3	0,1	-0,9	-1,2	-1,4	-0,3	0,4	0,4	0,3	0,3	0,3	0,2	0,2	0,2
..... ménages	-2,4	2,8	1,4	4,5	-2,5	2,9	2,6	1,0	0,0	-0,1	-0,1	-0,2	-0,2	-0,2	-0,3	-0,3
Importations	0,8	0,8	0,6	-0,8	1,2	0,0	1,1	4,0	0,4	0,4	0,4	0,4	0,4	0,4	0,4	0,4
Exportations	0,3	1,5	2,4	-1,7	2,7	-1,6	2,6	-0,1	0,8	0,8	0,8	0,8	0,8	0,8	0,8	0,8
Salaires	1,3	0,9	1,0	0,5	1,1	0,8	1,8	1,5	0,8	0,7	0,7	0,7	0,7	0,7	0,6	0,6
Pouvoir d'achat	-0,3	1,2	0,4	0,3	0,7	0,4	0,7	1,3	0,0	0,0	0,0	0,0	0,0	0,0	0,0	0,0
IPC	1,0	0,8	0,5	0,8	0,5	0,5	0,6	0,5	0,4	0,4	0,4	0,4	0,4	0,4	0,4	0,4
..... sous-jacent	0,7	0,8	0,6	0,5	0,5	0,4	0,5	0,4	0,4	0,4	0,4	0,4	0,4	0,4	0,4	0,4
Productivité	0,2	-0,1	0,4	0,1	-0,5	0,2	0,5	-0,3	0,2	0,2	0,1	0,1	0,1	0,1	0,1	0,1
Coûts salariaux unitaires	0,7	0,4	0,6	0,0	0,7	0,4	1,1	1,5	0,3	0,4	0,4	0,4	0,4	0,4	0,4	0,4

Pour comprendre la prévision réalisée (et les relations passées), nous calculons les contributions dynamiques des variables explicatives à la croissance des endogènes dans les équations comportementales.

# Calcul des contributions dynamiques ---------------------------------------

my_contrib <- sapply(names(info_equations),function(x) {
  dyn_contribs(get(x),
               my_prev,
               as.Date("2000-01-01"),
               as.Date(date_fin_prev),
               "date",
               info_equations[[x]]$residual_name) %>%
    filter(date>=as.Date("2000-01-01"))
}) %>%
  setNames(.,names(info_equations)) %>%
  as.list()

my_contrib_an <- lapply(my_contrib, function(x) {
  yearly_contrib(x,
                 index_year=substr(x[,"date"],start=1,stop=4))
})

# Graphiques ----------------------------------------------------------------

graphiques_q<- lapply(names(info_equations),function(x) {
  graph_contrib(
    my_contrib[[x]],
    as.Date("2017-01-01"),
    as.Date("2020-10-01"),
    "date",
    paste0("Contributions trimestrielles : ",
           info_equations[[x]]$endogenous_name)
  )
}) %>%
  setNames(names(info_equations))

graphiques_a <- lapply(names(info_equations),function(x) {
  graph_contrib(
    my_contrib_an[[x]],
    "2010",
    "2020",
    "year",
    paste0("Contributions annuelles : ",info_equations[[x]]$endogenous_name)
    )
})  %>%
  setNames(.,names(info_equations))

Voici par exemple les contributions dynamiques³ des variables explicatives à la croissance trimestrielles de nos variables prévues par des équations comportementales :

Voici les résultats annuels :

Ces équations sont données à titre d’exemple, sans que ne soit garantie leur robustesse.↩︎
Par souci de parcimonie, ceux-ci ne sont pas détaillés dans ce guide.↩︎
Les contributions dynamiques de l’équation du SMPT ne somment pas parfaitement car la force de rappel de l’équation est faible (cf. le manuel d’utilisation de tresthor).↩︎

tresthor Package R pour la prévision économique Application d’utilisation de tresthor en prévision : Modèle macroéconomique simplifié sur le Royaume-Uni

1 Chargement des données utilisées pour la prévision

2 Prévision des variables exogènes

3 Chargement du modèle et estimation des équations comportementales

4 Résolution du modèle en prévision

tresthor
Package R pour la prévision économique

Application d’utilisation de tresthor en prévision :
Modèle macroéconomique simplifié sur le Royaume-Uni