# Débrief : compléments d'information {#debrief}


```{block, type = "sources"}
[**Télécharger le fichier source**](06-debrief.Rmd)
```


## Le point sur les jointures


```{r joint-1}

library("dplyr")

```

Jointure à gauche, à droite, interne ou complète ? [(rappel
théorique)](https://basille.org/JPAR2021/manip.html#jointure-logique-left_join)

```{r joint-2}

band_members
band_instruments

left_join(band_members, band_instruments)
right_join(band_members, band_instruments)
inner_join(band_members, band_instruments)
full_join(band_members, band_instruments)

```

Par défaut, les jointures sont « naturelles », et se font sur les colonnes en
commun (même nom dans les deux tableaux). On peut changer cela avec l'argument
`by` :

```{r joint-3, error = TRUE}

left_join(band_members, band_instruments, by = "name")

names(band_instruments)
names(band_instruments)[1] <- "artist"

left_join(band_members, band_instruments)
left_join(band_members, band_instruments, by = "name")
left_join(band_members, band_instruments, by = c("name" = "artist"))

```

```{r joint-4}

band_members$last <- c("Jagger", "Lennon", "McCartney")
band_members <- add_row(band_members,
                        name = "Paul",
                        last = "Simon",
                        band = "Simon and Garfunkel"
                        )
band_instruments$last <- c("Lennon", "McCartney", "Richards")

left_join(band_members, band_instruments, by = c("name" = "artist"))
left_join(band_members, band_instruments, by = c("name" = "artist", "last"))

```

Toutes les colonnes qui ne font pas partie des correspondances sont modifiées
par l'ajout d'un suffixe ajustable via l'argument `suffix` (`.x` et `.y` par
défaut) :

```{r joint-5}

left_join(band_members, band_instruments, by = c("name" = "artist"),
    suffix = c("_members", "_instruments"))

```


### L'utilisation des jointures pour recoder les variables

Les jointures peuvent être utilisées pour recoder une variable à partir d'un
table de correspondance (*lookup table*, LUT, en anglais). Cela permet de
retrouver l'une des utilisations des « formats » sous SAS. Exemple avec les
données `um18` : on part de l'idée qu'on n'aurait pas la variable des domaines
disciplinaires abrégés, mais une table de correspondance à la place
(`lut_dom`). On utilise cette table pour une jointure à la volée afin de
récupérer la variable `domaine_disciplinaire` au format d'intérêt :

```{r joint-formats}

load("data/um18.RData")

lut_dom <- data.frame(
    domaine_disciplinaire = c("DROIT, ECONOMIE, GESTION", "SCIENCES ET TECHNOLOGIES",
        "DROIT-SCIENCE POLITIQUE", "SCIENCES, TECHNOLOGIES, SANTE",
        "SCIENCES HUMAINES ET SOCIALES", "ARTS, LETTRES, LANGUES"),
    dom_abr =  c("DEG", "ST", "DP", "STS", "SHS", "ALL")
) 

um18 %>%
    select(idetu, date_naiss, departement_pays, domaine_disciplinaire) %>%
    filter(!is.na(domaine_disciplinaire)) %>% 
    left_join(lut_dom) %>% 
    slice_head(n =  6)

```

Pour des cas plus complexes, par exemple des formats numériques, on pourra
utiliser au choix `ifelse` ou `case_when` (voir ci-dessous).


## Quelques pas vers la programmation fonctionnelle


### Condition `if`/`else`

Nous avons vu les opérations de comparaison et les filtres de données sur
critère dans [le module de manipulation des
données](manip.html#filtrer-selon-un-critère-filter) ; R propose un mécanisme
plus général via les conditions `if`/`else` (qui fonctionnent comme dans à peu
près n'importe quel langage).

```{r nomnoml, echo = FALSE, message = FALSE, warning = FALSE}

library("nomnoml")

```

```{nomnoml nomnoml-if, echo = FALSE}
#arrowSize: 0.7
#direction: down
#fill: #eee8d5; #fdf6e3
#fillArrows: true
#lineWidth: 2
#.data: fill=#3b547a stroke=white dashed title=bold body=center
#.code: visual=frame title=left,italic stroke=#3b547a

[<frame>if/else |
    [<note>condition] -> [<code>si VRAI | code{…}]
    [si VRAI] -/- [<code>sinon | code{…}]

    [condition] --> [sinon]
]

```

```{r if}

critere <- 10

if (critere == 10){
    "Ça vaut 10."
} else "Ça vaut pas 10."

critere <- 5

if (critere == 10){
    "Ça vaut 10."
} else "Ça vaut pas 10."

```

**Note 1 :** La partie `else {}` est optionnelle, on peut s'arrêter au `if`. En
plus de cela, les `if` peuvent être imbriqués :

```{r if-2}

critere <- 10

if (critere > 10){
    "C'est plus grand que 10."
} else if (critere < 10){
    "C'est plus petit que 10."
} else "P't-être bin qu'oui, p't-être bin qu'non…"


```

**Note 2 :** R interprète implicitement un objet logique comme une égalité à
`TRUE` (par opposition à `FALSE`), et une valeur comme différente de 0, comme
dans ces exemples :

```{r if-3}

critere <- TRUE
if (critere)
    "C'est vrai !"

critere <- -pi
if (critere)
    "C'est vrai !"

```


### Version vectorisée `ifelse` (`if_else`)

R étant très orienté données (et tableaux de données), il existe une alternative
vectorisée des conditions `if` : la fonction `ifelse` (ou si l'on veut rester
dans la logique du package `dplyr` : `if_else`).

```{nomnoml nomnoml-ifelse, echo = FALSE}
#arrowSize: 0.7
#fill: #eee8d5; #fdf6e3
#fillArrows: true
#lineWidth: 2
#.data: fill=#3b547a stroke=white dashed title=bold body=center
#.code: visual=frame title=left,italic stroke=#3b547a

[<frame>ifelse (if_else) |
    [<data>vec | A | B | A | C | B | A | C]
    [<note>condition | 
        [<code>si VRAI | code{…}];
        [<code>sinon | code{…}]
    ]
    [<data>vec2 | 1 | 2 | 1 | 2 | 2 | 1 | 2]

    [vec]->[condition]
    [condition]->[vec2]
]

```

```{r ifelse}

ifelse(iris$Sepal.Length >= mean(iris$Sepal.Length), "Grand", "Petit")
iris$taille <- ifelse(iris$Sepal.Length >= mean(iris$Sepal.Length), "Grand", "Petit")
iris

```

On peut également imbriquer les `ifelse` :


```{r ifelse-2}

iris$taille <- ifelse(iris$Sepal.Length > 6, "Grand",
    ifelse(iris$Sepal.Length > 5.5, "Moyen",
        "Petit"))
iris

```

En revanche, si l'on a un plus grand nombre de conditions, on lui préferera la
fonction `case_when` de `dplyr` (`case_when` évalue les conditions une par une
dans la séquence donnée, `TRUE` remplaçant le dernier « sinon ») :

```{r ifelse-3}

iris$taille <- case_when(
    iris$Sepal.Length >= 6.5 ~ "Très grand",
    iris$Sepal.Length >= 6   ~ "Grand",
    iris$Sepal.Length >= 5.5 ~ "Moyen",
    iris$Sepal.Length >= 5   ~ "Petit",
    TRUE                     ~ "Très petit")
iris

```


### Boucles sur indices `for` (et `lapply`)

Quand on veut faire des répétitions d'instructions, on fait des boucles. R
propose plusieurs mécanismes de boucles, dont le plus simple est la boucle sur
indices `for`.

```{nomnoml nomnoml-for, echo = FALSE}
#arrowSize: 0.7
#direction: down
#fill: #eee8d5; #fdf6e3
#fillArrows: true
#lineWidth: 2
#.data: fill=#3b547a stroke=white dashed title=bold body=center
#.code: stroke=#3b547a

[<frame>for |
    [<note>boucle : indice] -> [<code>code{…}]
    [code{…}] -> [boucle : indice]
    [code{…}] -/- [<state>fin]

    [boucle : indice] -> [fin]
]

```

Elle est en principe associée à un indice dont on connaît à l'avance les valeurs
:

```{r for}

for (i in 1:10)
    print(i^i)

for (i in unique(iris$Species))
    print(mean(iris$Sepal.Length[iris$Species == i]))

```

Ici aussi, on peut imbriquer les boucles `for` pour faire des répétitions
hiérarchiques sur plusieurs niveaux de boucles.

**Note 1:** La boucle `for` ne renvoie rien explicitement. Il faut donc soit
l'afficher (avec `print` ou `message` par exemple), soit l'enregistrer dans un
objet au sein de la boucle `for`.

**Note 2 :** Les boucles `for` sont très intuitives, mais souvent peu efficaces
sous R (le temps de traitement peut s'allonger exponentiellement). Si cela
devient un problème, il existe une alternative beaucoup moins intuitive mais
très efficace via la fonction `lapply` (qui travaille et renvoie des listes). La
boucle précédente devient alors :

```{r for-lapply}

lapply(1:10, function(i) i^i)

```


### Boucles sur condition `while`

Une autre forme est la boucle sur condition `while`. Celle-ci permet de répéter
des instructions tant que la condition est vraie, puis de terminer quand
celle-ci devient fausse.

```{nomnoml nomnoml-while, echo = FALSE}
#arrowSize: 0.7
#direction: down
#fill: #eee8d5; #fdf6e3
#fillArrows: true
#lineWidth: 2
#.data: fill=#3b547a stroke=white dashed title=bold body=center
#.code: title=left body=left,italic stroke=#3b547a

[<frame>while |
    [<note>boucle : condition] -> [<code>si VRAI :;code{…}]
    [si VRAI :;code{…}] -> [boucle : condition]
    [si VRAI :;code{…}] -/- [<state>sinon :;fin]

    [boucle : condition] -> [sinon :;fin]
]

```

Elle est en général associé à un indice dont on ne sait pas quand il va sortir
de la condition testée :

```{r while}

i <- 0
while (i < 9){
    print(i)
    i <- sample(1:10, 1)
}

```


## Supprimer les doublons


### Fonction `distinct()`

```{r dup-1}

load("data/um18.RData")

dim(um18)
um18 <- distinct(um18)
dim(um18)

distinct(um18, idetu)

```

### Fonction `duplicated()`

```{r dup-2}

sum(duplicated(um18$idetu))
head(which(duplicated(um18$idetu)))
um18[137, ]
um18 %>%
  filter(idetu == 2211887) %>%
  select(idetu, inscription_premiere, dom_abr, men_abr)

um18 %>%
  filter(inscription_premiere == "oui") -> um18dd

```

### Fonction `all.equal()`


```{r dup-3}

sum(duplicated(um18dd$idetu))
head(which(duplicated(um18dd$idetu)))
um18[105, ]
um18 %>%
  filter(idetu == 920978) %>%
  select(idetu, inscription_premiere, dom_abr, men_abr)

um18 %>%
  filter(idetu == 920978) %>%
  slice(1) -> toto

um18 %>%
  filter(idetu == 920978) %>%
  slice(2) -> tata

all.equal(toto, tata)
toto$ins19_diplom
tata$ins19_diplom

```


## Régression logistique

**Ceci n'est pas un précis de statistiques ; il y a de très bons tutoriels en
ligne, je vous invite à étudier ou réviser les bases mathématiques de la
régression logistique avant de la mettre en œuvre.**


```{r logi-1}

load("data/um18.RData")
names(um18)
table(um18$temoin_dip, useNA = "always")
um18$reussite <- ifelse(um18$temoin_dip == "O", 1, 0)
table(um18$reussite)
um18$age <- as.numeric((as.POSIXct("2018-09-01") - um18$date_naiss)/365.24)
summary(um18$age)
table(um18$bac_regroup)

```

```{r logi-2}

glm(reussite ~ age + civilite + bac_regroup, family = binomial, data = um18)

```

```{r logi-3}

glm1 <- glm(reussite ~ age + civilite + bac_regroup, family = binomial, data = um18)
summary(glm1)
confint(glm1)

```

```{r logi-4}

glm1_ci <- data.frame(confint(glm1))
glm1_ci$est <- glm1$coefficients
glm1_ci$name <- row.names(glm1_ci)

library("ggplot2")
ggplot(glm1_ci, aes(x = est, y = reorder(name, est))) +
  geom_point() +
  geom_segment(aes(x = X2.5.., xend = X97.5.., y = name, yend = name)) +
  geom_vline(xintercept = 0, size = .5, linetype = 2)

```


## Les graines aléatoires

Un certain nombre de fonctions font appel à des générateurs aléatoires de
nombres, ou des tirages aléatoires.

```{r seed-1}

rnorm(5)
rnorm(5)
sample(1:10, 5)
sample(1:10, 5)
sample(1:6, 1)
sample(1:6, 1)

```

On peut étonnamment bloquer le générateur aléatoire pour sortir les mêmes
valeurs lorsque l'on reproduit l'analyse (mais ces valeurs sont toujours
aléatoires en soi !) :


```{r seed-2}

set.seed(999)
rnorm(5)
set.seed(999)
rnorm(5)

set.seed(42)
sample(1:10, 5)
set.seed(42)
sample(1:10, 5)

```


## Nuages de mots

Le traitement de texte (notamment la fouille de texte, en anglais *text mining*)
est un travail complexe, que ce soit sous R ou non. R fournit toutefois une
large palette d'outils, nativement ou bien dans des packages. Je renvois
notamment pour cela sur les packages `tidytext`, `tm` et `textstem`.

Une des applications concrètes est de faire un nuage de mots. Amusons-nous un
peu ici avec le package `ggwordcloud` qui permet de faire des nuages de mots
avancés dans le contexte de `ggplot2` :


```{r wordcloud-1}

library("ggwordcloud")

```

```{r wordcloud-2}

love_words
summary(love_words)

ggplot(love_words, aes(label = word)) +
  geom_text_wordcloud() +
  theme_minimal()

```

```{r wordcloud-3}

ggplot(love_words, aes(label = word, size = speakers)) +
  geom_text_wordcloud() +
  theme_minimal()

```

```{r wordcloud-4}

love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers)) +
  geom_text_wordcloud() +
  scale_size_area(max_size = 20) +
  theme_minimal()

```

```{r wordcloud-5}

set.seed(42)
love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers)) +
  geom_text_wordcloud() +
  scale_size_area(max_size = 20) +
  theme_minimal()

```

```{r wordcloud-6}

library("viridis")
set.seed(42)
love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers, color = speakers)) +
  geom_text_wordcloud() +
  scale_size_area(max_size = 20) +
  scale_color_viridis(option = "plasma", end = .8, direction = -1) +
  theme_minimal()

```

```{r wordcloud-7}

set.seed(42)
love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers, color = speakers)) +
  geom_text_wordcloud(eccentricity = 2) +
  scale_size_area(max_size = 20) +
  scale_color_viridis(option = "plasma", end = .8, direction = -1) +
  theme_minimal()

```

```{r wordcloud-8}

set.seed(42)
love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers, color = speakers)) +
  geom_text_wordcloud(eccentricity = 2, shape = "square") +
  scale_size_area(max_size = 20) +
  scale_color_viridis(option = "plasma", end = .8, direction = -1) +
  theme_minimal()

```

Dernier exemple, qui ne marche pas à tous les coups :


```{r wordcloud-9, eval = FALSE}

set.seed(42)
love_words %>% 
  filter(speakers > 50) %>% 
ggplot(aes(label = word, size = speakers, color = speakers)) +
  geom_text_wordcloud_area(
    mask = png::readPNG(system.file("extdata/hearth.png",
                                    package = "ggwordcloud", mustWork = TRUE
    )),
    rm_outside = TRUE
  ) +
  scale_size_area(max_size = 30) +
  scale_color_viridis(option = "plasma", end = .8, direction = -1) +
  theme_minimal()

```

```{r wordcloud-heart, echo = FALSE, fig.align = "center", out.width = "698px"}

knitr::include_graphics("images/wordcloud-heart.png")

```


## Rapports paramétrés (*parameterized reports*)

* [Modèle pour les
  rapports](https://basille.org/JPAR2021/rapports/template-pdf.Rmd)

```{r param-1, eval = FALSE}

rmarkdown::render("rapports/template-pdf.Rmd")
rmarkdown::render("rapports/template-pdf.Rmd", params = list(species = "setosa"))
rmarkdown::render("rapports/template-pdf.Rmd", params = list(species = "versicolor"))

```

```{r param-2, eval = FALSE}

for (i in unique(iris$Species))
    rmarkdown::render("rapports/template-pdf.Rmd",
        output_file = paste0(i, ".pdf"),
        params = list(species = i)
    )

```

* [Pour aller plus
  loin](https://bookdown.org/yihui/rmarkdown/parameterized-reports.html).
  
