Skip to content

Détection et prévision des points de retournement par une méthode bayésienne de classification (Kaufmann, S., 2010) @RomainLes @AQLT

License

Notifications You must be signed in to change notification settings

ARKEnsae/BayesianTurningPoint

Repository files navigation

BayesianTurningPoint

Projet de statistique bayésienne de Romain LESAUVAGE et Alain QUARTIER-LA-TENTE sur l'article :

Kaufmann, S. (2010). Dating and forecasting turning points by Bayesian clustering with dynamic structure: a suggestion with an application to Austrian data, Journal of Applied Econometrics, 25, 309 – 344.

Le projet complet est disponible ici : https://github.com/ARKEnsae/BayesianTurningPoint

Le rapport : https://arkensae.github.io/BayesianTurningPoint/Rédaction/Rapport.pdf

Le fichier "programmes/1 - Launche_me.m" contient les 3 commandes à lancer pour lancer le programmes sous Matlab (après avoir changé le working directory au dossier programmes) :

  • Pour lancer les estimations :
run 'start_model4_logit'
run 'permut_MS_ALL'

Ces deux programmes peuvent mettre longtemps à tourner, pour n'avoir que les graphiques il faut télécharger le fichier suivant et le mettre dans le dossier programmes : https://github.com/ARKEnsae/BayesianTurningPoint/raw/main/programmes/logit1_dyn0_shr1_var1_perm0_sg1_K3end2_ex0_grspecstd_2020.75_2020_iden

  • Pour tracer les graphiques :
run 'plot_ALL'

Ces programmes sont une adaptation de ceux de Kaufmann (2010) (http://qed.econ.queensu.ca/jae/2010-v25.2/kaufmann/) afin qu'ils puissent être appliqués aux données françaises

La datation de référence des cycles de croissance peut-être obtenue depuis R avec le code suivant :

library(mFilter)
# PIB trimestriel en évolution :
pib <- structure(c(0.7, 0.4, 0.4, 0.3, 0, 0.3, 0.3, 0.4, 1, -0.1, 0, 
				   -0.2, -0.6, 0.1, 0.2, 0.2, 0.8, 1.1, 0.6, 0.9, 0.6, 0.4, 0.2, 
				   0.2, 0.6, 0.2, 0.6, 0.1, 0.3, 1.1, 0.7, 1.1, 0.8, 0.9, 0.7, 0.7, 
				   0.6, 0.9, 1.2, 1.4, 1, 1, 0.6, 0.8, 0.6, 0.1, 0.3, 0, 0.4, 0.5, 
				   0.4, 0, 0.2, -0.2, 0.7, 0.7, 0.9, 0.7, 0.3, 0.7, 0.3, 0.2, 0.5, 
				   0.7, 0.8, 1, 0, 0.8, 0.7, 0.8, 0.3, 0.2, 0.4, -0.5, -0.3, -1.4, 
				   -1.7, -0.1, 0.2, 0.7, 0.4, 0.5, 0.6, 0.7, 1, 0, 0.3, 0.2, 0.1, 
				   -0.2, 0.2, -0.1, 0, 0.7, 0, 0.5, 0.1, 0.1, 0.4, 0.1, 0.5, 0, 
				   0.4, 0.1, 0.7, -0.2, 0.2, 0.6, 0.8, 0.7, 0.7, 0.8, 0.1, 0.2, 
				   0.4, 0.6), .Tsp = c(1990, 2018.75, 4), class = "ts")
# Indicateur de retournement :
ind_ret <- structure(c(-0.88, -0.84, -1, -1, -0.98, -1, -1, -1, -1, -1, 
					   -1, -1, -1, -0.75, -0.76, -0.51, -0.98, -1, -0.99, -0.85, -0.67, 
					   -0.52, -0.25, 0.39, 0.96, 1, 1, 1, 0.97, 0.96, 0.99, 1, 1, 0.99, 
					   0.99, 0.96, 0.91, -0.72, -0.7, -0.46, -0.36, -0.28, -0.19, -1, 
					   -1, -1, -1, -1, -0.89, -0.71, -0.59, -0.39, -0.66, -0.9, -0.97, 
					   -0.65, -0.6, -0.45, -0.11, 0.48, 0.94, 0.96, 0.99, 0.91, 0.84, 
					   0.92, 0.87, 0.99, 1, 1, 0.99, 1, 1, 1, 1, 0.94, 0.9, 0.95, 0.96, 
					   0.94, 0.85, -0.66, -0.38, -0.42, -0.27, 0.35, 0.75, 0.84, 0.98, 
					   0.96, 1, 1, 1, 1, 0.96, 0.99, 0.93, 0.91, 0.99, 1, 0.96, 1, 0.97, 
					   0.91, 0.99, 1, 0.94, 0.86, 0.77, 0.76, 0.65, -0.86, -0.69, -0.48, 
					   -0.61, -0.92, -0.98, -0.97, -0.53, -0.67, 0.14, 0, 0.92, 0.84, 
					   0.79, 0.63, 0.19, 0.39, 0.35, 0.23, -0.01, 0.28, 0.19, 0.22, 
					   -0.98, -0.75, -0.44, -0.6, 0.15, 0.96, 1, 0.98, 1, 1, 0.99, 0.93, 
					   0.98, 0.95, 0.86, 0.83, 0.79, 0.72, 0.7, 0.91, 0.72, 0.84, 0.73, 
					   0.72, 0.72, 0.69, 0.63, 0.97, 0.89, 0.88, 0.81, 0.98, 0.91, 0.93, 
					   0.98, 0.89, 0.84, 0.96, 1, 0.89, 0.95, 0.99, 1, 0.99, 0.94, 0.86, 
					   0.89, 0.95, 0.91, 0.96, 0.96, 1, 0.99, 0.91, 0.91, 0.81, 0.89, 
					   0.77, 0.74, 0.7, 0.79, 0.6, 0.45, 0.19, -0.99, -0.84, -1, -1, 
					   -0.99, -1, -0.94, -1, -0.89, -0.75, -0.34, -0.13, 0.03, 0.65, 
					   0.97, 0.96, 0.92, 0.85, 0.82, 0.74, 0.75, 0.93, 0.96, 0.86, 0.96, 
					   1, 0.94, 0.99, 0.99, 1, 1, 0.99, 0.99, 0.92, 0.85, 0.9, 0.76, 
					   -0.93, -0.93, -0.77, -0.67, -0.55, -0.44, -0.85, 0.04, -0.31, 
					   -0.96, -0.97, -0.95, -0.79, -0.67, -0.99, -0.81, -0.68, -0.7, 
					   -0.83, -0.99, -1, -0.8, -0.69, -0.07, 0.85, 0.99, 0.9, 0.82, 
					   0.76, 0.97, 0.72, 0.98, -0.27, -0.46, -0.21, -0.72, -0.57, -0.8, 
					   -0.98, -0.78, -0.75, -0.95, -0.86, -0.32, 0.11, 0.23, 0.68, 0.96, 
					   0.97, 0.85, 0.82, 0.68, 0.67, 0.85, 0.62, 0.65, 0.61, 0.68, 0.52, 
					   0.79, 0.65, 0.91, 0.91, 0.91, 0.91, 0.81, 0.98, 0.88, 0.88, 0.81, 
					   0.95, 0.92, 0.98, 0.91, 0.97, 0.97, 1, 0.97, 0.89, 0.84, 0.82, 
					   0.79, 0.8, 0.72, 0.68, 0.68, 0.6, 0.86, 0.73, 0.93, 0.85, 0.98, 
					   0.84, 0.99, 0.9, 0.84, 0.84, 0.94, 0.84, 0.87, 0.92, 0.87, 0.84, 
					   0.21, -1, -0.69, -0.05, 0.93, 1, 0.93, 0.76, 0.47, 0.8, 0.71), .Dim = c(349L, 
					   																		1L), .Dimnames = list(NULL, "001565531"), .Tsp = c(1992, 2021, 
					   																														   12), class = "ts")
simpl_cycle <- function(x, min_phase=4){
# Pour ne garder que les cycles de 4 trimestres
	prec_valeur = x[1]
	for (i in 2:(length(x)-min_phase)){
		if(x[i]!=prec_valeur){
			if(length(unique(x[i+1:min_phase-1]))==1){
				prec_valeur = x[i]
			}else{
				x[i] = prec_valeur
			}
		}
	}
	last_val <- x[(length(x)-min_phase+1):length(x)]
	if(length(unique(last_val))>1){
		d <- as.data.frame(table(last_val))
		x[(length(x)-min_phase+1):length(x)] <- as.numeric(levels(d$last_val)[d$last_val[which.max(d$Freq)]])
	}
	x
}
cff <- cffilter(pib,pl = 1.5*4, pu = 10*4)

conj <- 2*((cff$cycle)>=0) - 1
simpl_cycle(conj)

plot(simpl_cycle(conj),xlim = c(1992,2020))
lines(ind_ret, col = "red")

About

Détection et prévision des points de retournement par une méthode bayésienne de classification (Kaufmann, S., 2010) @RomainLes @AQLT

Topics

Resources

License

Stars

Watchers

Forks