« Pattern matching » avec R

Dans la continuité du précédent billet, je tente cette fois-ci de réaliser la détection des épisodes récessifs survenus dans la zone Euro depuis 2000 à l’aide de R.
Les données utilisées sont identiques (et sont d’ailleurs directement extraites de la base de données).

Chargement des données

> library(ROracle)
Le chargement a nécessité le package : DBI
Warning message:
le package ‘DBI’ a été compilé avec la version R 3.2.1
> ora = Oracle()
> cnx = dbConnect(ora, username="rafa", password="rafa", dbname="S1401037:1521/STATPDB")
> pib_evol <- dbGetQuery(cnx, "select * from pib_evol")
> dbDisconnect(cnx)
[1] TRUE
>
> summary(pib_evol)
     PAYS               ANNEE        TRIMESTRE          PIB         
 Length:1068        Min.   :2000   Min.   :1.000   Min.   :  19646  
 Class :character   1st Qu.:2003   1st Qu.:1.000   1st Qu.:  59231  
 Mode  :character   Median :2007   Median :2.000   Median : 269247  
                    Mean   :2007   Mean   :2.475   Mean   : 691366  
                    3rd Qu.:2011   3rd Qu.:3.000   3rd Qu.: 751208  
                    Max.   :2015   Max.   :4.000   Max.   :3497207
>
> pib_evol$PAYS <- as.factor(pib_evol$PAYS)
>

Codage du trimestre (as.yearqtr)

> library(zoo)

Attachement du package : ‘zoo’

The following objects are masked from ‘package:base’:

 as.Date, as.Date.numeric

> pib_evol$QTR <- paste(pib_evol$ANNEE,"-", pib_evol$TRIMESTRE, sep="")
> pib_evol$QTR <- as.yearqtr(pib_evol$QTR)
> 
> pib_evol <- pib_evol[,c("PAYS","QTR","PIB")]
> head(pib_evol)
      PAYS     QTR      PIB
1 Autriche 2000 Q1 297275.4
2 Autriche 2000 Q2 301053.0
3 Autriche 2000 Q3 302616.9
4 Autriche 2000 Q4 307202.8
5 Autriche 2001 Q1 306744.5
6 Autriche 2001 Q2 305478.4
>

Pivotement du dataset (dcast)

> library(reshape2)
> pib_evol_pays <- dcast(data = pib_evol, formula = QTR ~ PAYS)
Using PIB as value column: use value.var to override.
> 
> head(pib_evol_pays)
      QTR Allemagne Autriche Belgique Espagne  Estonie Finlande  France    Grèce  Irlande  Italie Lettonie Lituanie Luxembourg Pays-Bas Portugal
1 2000 Q1   2941021 297275.4 361522.4 1189010 19645.98 171950.0 2046747 265121.7 140751.9 1970825 24553.47 39927.56   32714.13 642933.5 263260.2
2 2000 Q2   2970499 301053.0 363755.5 1203697 20152.38 171857.8 2062126 267881.0 144412.8 1989325 24574.84 40307.34   32606.38 650271.5 261729.2
3 2000 Q3   2965640 302616.9 365060.7 1216639 20342.40 174338.8 2075392 272843.6 148590.6 2000858 25354.32 40732.99   33460.48 656277.2 265393.1
4 2000 Q4   2968232 307202.8 368319.3 1230144 20927.21 176051.4 2092983 276631.9 152488.7 2026320 25220.49 41431.49   32370.47 663496.8 267408.2
5 2001 Q1   3017306 306744.5 368372.6 1242406 21169.45 177720.0 2106714 279797.6 154225.7 2040414 25524.77 42630.47   34083.26 664379.8 266772.7
6 2001 Q2   3019574 305478.4 368004.1 1252242 21398.56 177641.0 2107050 279534.8 154267.4 2030788 26857.67 42531.60   32821.82 667105.5 269042.3
  République slovaque Slovénie
1            81099.31 42507.91
2            81920.08 43388.81
3            82458.10 43865.37
4            82991.53 44158.33
5            83534.55 44607.08
6            84443.95 44718.89
>

Conversion en série temporelle (xts)

> library(xts)
> pib_evol_pays_ts <- xts(x = pib_evol_pays[, -1], order.by = pib_evol_pays$QTR)
> head(pib_evol_pays_ts)
        Allemagne Autriche Belgique Espagne  Estonie Finlande  France    Grèce  Irlande  Italie Lettonie Lituanie Luxembourg Pays-Bas Portugal
2000 Q1   2941021 297275.4 361522.4 1189010 19645.98 171950.0 2046747 265121.7 140751.9 1970825 24553.47 39927.56   32714.13 642933.5 263260.2
2000 Q2   2970499 301053.0 363755.5 1203697 20152.38 171857.8 2062126 267881.0 144412.8 1989325 24574.84 40307.34   32606.38 650271.5 261729.2
2000 Q3   2965640 302616.9 365060.7 1216639 20342.40 174338.8 2075392 272843.6 148590.6 2000858 25354.32 40732.99   33460.48 656277.2 265393.1
2000 Q4   2968232 307202.8 368319.3 1230144 20927.21 176051.4 2092983 276631.9 152488.7 2026320 25220.49 41431.49   32370.47 663496.8 267408.2
2001 Q1   3017306 306744.5 368372.6 1242406 21169.45 177720.0 2106714 279797.6 154225.7 2040414 25524.77 42630.47   34083.26 664379.8 266772.7
2001 Q2   3019574 305478.4 368004.1 1252242 21398.56 177641.0 2107050 279534.8 154267.4 2030788 26857.67 42531.60   32821.82 667105.5 269042.3
        République slovaque Slovénie
2000 Q1            81099.31 42507.91
2000 Q2            81920.08 43388.81
2000 Q3            82458.10 43865.37
2000 Q4            82991.53 44158.33
2001 Q1            83534.55 44607.08
2001 Q2            84443.95 44718.89
>

Recherche des séquences de contraction du PIB

Dans le bloc ci-dessous, la fonction diff permet de réaliser la différence de la valeur d’une ligne avec la suivante. Ce résultat est passé à la fonction sign (-1/0/1) dont la sortie est testée (==1) afin de déterminer si la différence est positive ou pas.
La conversion as.numeric du résultat du test transforme le booléen (TRUE/FALSE) en 0 ou 1. Ensuite, l’ensemble de ces résultats 0/1 sont concaténés via la fonction paste.

On obtient alors pour chaque pays une chaine de caractère représentant les survenues de contractions du PIB sous la forme d’un bitmap.
Il est alors aisé de rechercher dans ce bitmap les occurrences de 3 (ou plus) contractions successives à l’aide de la fonction gregexpr et de l’expression régulière « 000+ »:

> recessions <-lapply(
 + pib_evol_pays_ts,
 + function(x) (
 + gregexpr("000+",
 + paste(
 + as.numeric(
 + sign(diff(x))==1
 + )
 + , collapse="")
 + )
 + )
 + )
>

Le résultat est une liste dont chaque membre correspond à un pays et dont les éléments correspondent respectivement aux indices (dans le dataframe pib_evol_pays_ts) des épisodes récessifs ainsi qu’à leur durée (en nombre de diminutions successives):

> typeof(recessions)
[1] "list"
>
> head(recessions,3)
$Allemagne
$Allemagne[[1]]
[1] 35
attr(,"match.length")
[1] 4
attr(,"useBytes")
[1] TRUE


$Autriche
$Autriche[[1]]
[1] 6 35
attr(,"match.length")
[1] 3 5
attr(,"useBytes")
[1] TRUE


$Belgique
$Belgique[[1]]
[1] 7 36
attr(,"match.length")
[1] 3 4
attr(,"useBytes")
[1] TRUE


>

Présentation du résultat

On construit finalement un dataframe qui liste l’ensemble des épisodes récessifs de la zone Euro. Chaque ligne reprend une récession en indiquant le pays concerné, le trimestre de début, le nombre de trimestres de baisse et finalement le pourcentage de baisse:

> res1 <- data.frame(Pays=character(1), Trim=numeric(1), Nb_trim_rec=numeric(1), Pct_rec=numeric(1) )
> for (y in 1:length(recessions))
+ {
+ if ( unlist(recessions[[y]])[1] != -1 )
+ {
+ idx_deb_rec <- unlist(recessions[[y]]) - 1;
+ nb_trim_rec <- attr(recessions[[y]][[1]],"match.length");
+ pays_rec <- names(recessions)[y];
+ pct_rec <- round(100 * ((pib_evol_pays[idx_deb_rec,pays_rec] - pib_evol_pays[idx_deb_rec + nb_trim_rec -1,pays_rec]) / pib_evol_pays[idx_deb_rec,pays_rec] ),2);
+ df1 <- data.frame(pays_rec, pib_evol_pays[idx_deb_rec,"QTR"],nb_trim_rec, pct_rec)
+ names(df1) <- c("Pays","Trim","Nb_trim_rec","Pct_rec")
+ res1 <- rbind(res1, df1)
+ }
+ }
> res1$Trim <- as.yearqtr(res1$Trim)
> res1[-1,]
         Pays    Trim Nb_trim_rec Pct_rec
2   Allemagne 2008 Q2           4    6.68
3    Autriche 2001 Q1           3    0.61
4    Autriche 2008 Q2           5    5.14
5    Belgique 2001 Q2           3    0.29
6    Belgique 2008 Q3           4    3.32
7     Espagne 2008 Q3           6    3.90
8     Espagne 2011 Q1          10    5.04
9     Estonie 2008 Q3           5   17.90
10   Finlande 2008 Q4           3    7.00
11   Finlande 2012 Q2           4    1.33
12     France 2008 Q2           5    3.49
13      Grèce 2008 Q2           4    6.14
14      Grèce 2009 Q3          16   23.20
15    Irlande 2008 Q1           8    9.26
16     Italie 2001 Q2           3    0.47
17     Italie 2007 Q2           3    0.30
18     Italie 2008 Q2           5    6.90
19     Italie 2011 Q3           8    4.66
20     Italie 2013 Q4           5    0.45
21   Lettonie 2007 Q4           8   21.82
22   Lettonie 2010 Q1           3    0.75
23   Lituanie 2008 Q3           4   14.50
24 Luxembourg 2002 Q3           3    1.77
25 Luxembourg 2008 Q2           5    8.35
26   Pays-Bas 2008 Q3           4    4.22
27   Portugal 2002 Q2           3    1.23
28   Portugal 2008 Q2           4    3.84
29   Portugal 2010 Q4           9    7.81
30   Slovénie 2008 Q3           4    9.21
31   Slovénie 2011 Q3           7    4.27
>

On retrouve finalement les même informations que celles obtenues dans le billet précédent mais il faut bien reconnaitre que l’utilisation de MATCH_RECOGNIZE est nettement plus simple que les opérations ci-dessus.

Laisser un commentaire

Votre adresse de messagerie ne sera pas publiée. Les champs obligatoires sont indiqués avec *

eight × = sixteen