R: Partage & Echange

{purrr::map()}

Contexte

• Purrr est un package faisant partie de tidyverse
  
• Permet de faire de la Programmation fonctionnelle
  
• Fonction qui utilise en argument une autre fonction

Exemple

Répartition des avoirs des clients

str(info_pf)

## tibble [4,874 × 8] (S3: tbl_df/tbl/data.frame)
##  $ id_client        : int [1:4874] 864 1360 4277 1328 1278 2893 1444 657 3592 4261 ...
##  $ credit           : num [1:4874] 1016841 8137274 5023547 2060564 264816 ...
##  $ gestion_discret  : num [1:4874] 16284336 8665893 174375 1521669 8828647 ...
##  $ titre            : num [1:4874] 342551 25747922 2207307 3386538 12902743 ...
##  $ cash             : num [1:4874] 1097414 3983013 1445817 11069982 6203 ...
##  $ autre_actif_geres: num [1:4874] 3987031 554174 13601091 8210035 4207199 ...
##  $ segment          : chr [1:4874] "Private Banking" "CFG" "Personal Banking" "Private Banking" ...
##  $ year             : int [1:4874] 2015 2017 2018 2018 2018 2016 2015 2015 2017 2017 ...

• Dataset avec 5 type d’encours de 2015 à 2019

On veut connaitre le montant total
par classe d’actif en 2019

pf2019 <- info_pf %>% 
  filter(year==2019)

Loop for

n <- 5
# Creation Matrice resultat
loop_res <- matrix(nrow=1, ncol=n, 
                   dimnames = list(NULL,
                                   c("credit", "gestion_discret",
                                     "titre", "cash", 
                                     "autre_actif_geres")))
# Creation boucle
for(i in 1:n){
  ii <- i+1
  loop_res[i] <- sum(pf2019[ii]) 
}

loop_res

##           credit gestion_discret       titre       cash autre_actif_geres
## [1,] 10116717650      5644834266 10273873712 9993894318        9975145822

Functionnal

# Les etapes creation matrice resultat & boucle
# se font au meme niveau
fp_res <-  pf2019 %>% 
  select(c("credit", "gestion_discret","titre", "cash","autre_actif_geres")) %>% 
  map_df(sum)

fp_res

## # A tibble: 1 x 5
##         credit gestion_discret        titre        cash autre_actif_geres
##          <dbl>           <dbl>        <dbl>       <dbl>             <dbl>
## 1 10116717650.     5644834266. 10273873712. 9993894318.       9975145822.

Fonctionnement de map

Fonctionnement de map

Fonctionnement de map

Illustration

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec plusieurs colonnes

map(df, sum)

Avec une colonne

map(df, exp)

Avec une colonne

map(df, exp)

Avec une colonne

map(df, exp)

Avec une colonne

map(df, exp)

Avec une colonne

map(df, exp)

Famille map()

• map retroune une liste
• map_df retroune dataframe
• map_int retroune vecteur integer
• map_chr retroune vecteur caractere
• map2 va prendre 2 arguments (x, y, function)
• pmap va prendre p arguments (list, function)

walk()

• Même principe que map() -> (x, function)
• Retourne aucun objet
• Effet secondaire (sauvegarder, afficher)

Cas Pratique

• 1. Evolution des avoirs en gestion discretionnaire pour chacun des segments
• 2. Les afficher dans des graphiques
• 3. Insérer dans un PowerPoint

pf <- info_pf %>% 
  select(id_client, gestion_discret, segment, year) %>% 
  group_by(segment,year) %>% 
  summarise(gestion_discret= round(sum(gestion_discret)/1000000,2)) %>% 
  nest()

pf

## # A tibble: 3 x 2
## # Groups:   segment [3]
##   segment          data            
##   <chr>            <list>          
## 1 CFG              <tibble [5 × 2]>
## 2 Personal Banking <tibble [5 × 2]>
## 3 Private Banking  <tibble [5 × 2]>

Utilisation de map()

pf1 <- pf %>% 
  mutate(plots = map( data, function(x){ggplot(x) + 
                     geom_bar(aes(year, gestion_discret), stat='identity') +
                      ggtitle('Montant total en gestion discrétion') +
                     ylab("Montant en millions d'euros") + #ylab("Montant (millions de dollars)")
                     xlab("Année") +
                     theme_bw() +
                     theme(plot.title = element_text(lineheight = 1.1,size = 20,  hjust = 0.5),
                           plot.subtitle = element_text(lineheight = 1.1,  hjust = 0.5),
                           panel.grid.minor = element_blank(),
                           panel.grid.major = element_blank(),
                           panel.border = element_blank(),
                           axis.line.x = element_blank(),
                           legend.position = 'none'
                     )}
                     ))

Utilisation de map2()

pf2 <- pf %>% 
  mutate(plots = map2( .x=data,.y=segment, function(x, y){ggplot(x) + 
      geom_bar(aes(year, gestion_discret), stat='identity') +
      ggtitle('Montant total en gestion discrétion', subtitle=y) +
      ylab("Montant en millions d'euros") + #ylab("Montant (millions de dollars)")
      xlab("Année") +
      theme_bw() +
      theme(plot.title = element_text(lineheight = 1.1, size = 20,  hjust = 0.5),
            plot.subtitle = element_text(lineheight = 1.1,  hjust = 0.5),
            panel.grid.minor = element_blank(),
            panel.grid.major = element_blank(),
            panel.border = element_blank(),
            axis.line.x = element_blank(),
            legend.position = 'none'
      )}
  ))

Utilisation de pmap()

pf3 <- pf %>% 
  ungroup() %>% 
  mutate(fill_color=c('#779cb7', '#36824d', '#bfa4a2'),
         plots = pmap( list(data, segment, fill_color), function(x, y, z){ggplot(x) + 
      geom_bar(aes(year, gestion_discret), stat='identity', fill=z) +
      ggtitle('Montant total en gestion discrétion', subtitle=y) +
      ylab("Montant en millions d'euros") + #ylab("Montant (millions de dollars)")
      xlab("Année") +
      theme_bw() +
      theme(plot.title = element_text(lineheight = 1.1,size = 20,  hjust = 0.5),
            plot.subtitle = element_text(lineheight = 1.1,  hjust = 0.5),
            panel.grid.minor = element_blank(),
            panel.grid.major = element_blank(),
            panel.border = element_blank(),
            axis.line.x = element_blank(),
            legend.position = 'none'
      )}
  ))

Sauvegarde dans un Powerpoint

library(rvg)
library(officer)

create_pptx <- function(plot, path){
  
  read_pptx(path) %>%
    add_slide(layout = "Title and Content", master = "Office Theme") %>%
    ph_with(plot, location = ph_location_fullsize() ) %>% 
    print(target = path)
}

walk(tt3$plots, function(x){create_pptx(x, paste0(getwd(),'/test.pptx'))})

Résultat

Résultat

Récapitulatif

map()

• peut etre utilisé avec %>%
• peut retourner differents types d’objets
• peut prendre plusieurs arguments

Merci pour votre attention

Questions?

• Pourquoi utiliser les fonctions de {purrr} si les fonctions de type apply font la même chose?
• Est-ce que map fait les calculs en parallele?