evaluation.qmd

---
title: "Évaluation des fonctions en R"
format:
  live-html:
    webr:
      packages: ["dplyr", "disaggR"]
---

{{< include ./_extensions/r-wasm/live/_knitr.qmd >}}

## Expression

R repose (comme beaucoup de langages fonctionnels) sur des expressions. Une expression est comme une phrase en français mais en R. Une expression est simplement un ensemble **non-évalué** de code R syntaxiquement correct, même si ce sens peut être farfelu ou produire une erreur à l'évaluation dans un environnement (voire dans n'importe quel environnement).

```{r}
#| eval: false
1 + 2
function(x) sin(2*x)
round(exp(3) + 1, 5)
arnaud <- (bonjour + "voiture") ^ sqrt(2 + "train")
1 <- 2
```

Tout ce qui est au dessus est une expression avant d'être évalué, possiblement par une erreur. A contrario, les lignes ci-dessous ne peuvent pas correspondre à une expression. Elles sont syntaxiquement incorrectes.

```{=html}
<div class="sourceCode cell-code" id="cb1"><pre class="sourceCode r code-with-copy">2 *
exp(
<- 3</div>
```

Pour ne pas évaluer du code R *syntaxiquement correct* et le laisser sous forme d'expression, on peut utiliser `quote()`.

```{webr-r}
quote(1 + 2)
quote(function(x) sin(2*x))
quote(round(exp(3) + 1, 5))
quote(arnaud <- (bonjour + "voiture") ^ sqrt(2 + "train"))
quote(1 <- 2)
```

Le code syntaxiquement incorrect ne peut lui pas former une expression :

```{webr-r}
quote(2*)
quote(<- 3)
quote(1***5)
```

## Évaluation à temps d'exécution

Le code n'est interprêté qu'à son temps d'exécution. Contrairement à des langages plus formels qui donnent une importance plus grande au temps de "définition" ou "compilation". R attend le dernier moment pour vérifier si quelque chose a un sens.

```{webr-r}
setMachin <- function() assign("machin", 1, parent.frame())
  # Le code précédent écrit 1 dans l'environnement
  # parent de la fonction ; c'est une bidouille pour
  # l'exemple mais n'est pas à reproduire en prod

bizarre <- function() {
  setMachin()
  return(machin)
  arnaud <- (bonjour + "voiture") ^ sqrt(2 + "train")
}

bizarre()
```

Dans la petite bidouille ci-dessus, il serait bien difficile à un compilateur de prévoir que l'objet `machin` existe au moment de l'appel à `machin`. De même, dans certains langages de programmation, l'expression `arnaud <- (bonjour + "voiture") ^ sqrt(2 + "train")` pourrait être refusée dès qu'on la propose.

Mais R ne bronche pas. R n'essaye pas de donner un sens au corps des fonctions à l'avance. Dès lors que la syntaxe est correcte, ça lui suffit et on verra plus tard !

## Évaluation paresseuse et court-circuit

R est fainéant. Il n'évaluera les *arguments* d'une fonction qu'au dernier moment s'il en a besoin (*évaluation paresseuse des arguments*). Les expressions employant des contrôle (`if`, `else`...) définissent elles aussi une forme de paresse dans la mesure où leurs sous-parties non-retenues ne sont pas évaluées (*évaluation paresseuse des structures de contrôle*). À l'intérieur même des expressions, les expressions faites d'opérateurs logiques unitaires (`&&` et `||` mais pas `&` ni `|` qui sont vectoriels) évaluent elles aussi le moins possible de leurs sous-parties (*court-circuit*).

::: callout-note

## Remarque

Dans le monde de R, quand on parle d'évaluation paresseuse, on se réfère surtout à l'évaluation paresseuse des arguments. Mais l'évaluation paresseuse est un concept assez général. L'idée de base est de n'évaluer que ce dont on a absolument besoin et pile au moment où on en a besoin.

:::

```{webr-r}
lazy_eval <-
  function(x = stop("C'est une erreur !"),
           y = matrix(1:9, nrow = -3L)) {
    TRUE
  }
lazy_eval()
```

Dans l'exemple précédent, si les arguments n'étaient pas évalués de manière paresseuse, autant l'évaluation de `x` que celle de `y` précipiterait une erreur :

* celle de `x` car `stop()` est la fonction de R permettant de stopper l'exécution et de retourner une erreur avec le message fourni.
* celle de `y` car une matrice avec un nombre de lignes négatifs, ça n'existe pas.

Mais le corps de la fonction `lazy_eval` étant réduit à son plus simple appareil, à savoir simplement `TRUE`, il ne requiert pas d'en évaluer les arguments. Il n'y a donc aucune erreur d'exécution et la fonction retourne bien `TRUE` !

```{webr-r}
lazy_eval <-
  function(choix) {
    if (choix) TRUE
    else stop("C'est une erreur !")
  }
# Testez
# lazy_eval(choix = TRUE)
# et
# lazy_eval(choix = FALSE)
```

Dans l'exemple ci-dessus, on illustre le bon fonctionnement paresseux d'une structure de contrôle. La partie `else` n'est évaluée que si `choix` est `FALSE`.

```{webr-r}
lazy_eval <-
  function(choix, x = stop(), y = TRUE) {
    if (choix) y
    else x
  }
# Testez
# lazy_eval(choix = TRUE)
# et
# lazy_eval(choix = FALSE)
```

L'exemple ci-dessus repose à la fois sur la paresse des structures de contrôle et sur celle des arguments. L'argument x n'est évalué que dans le cas où `choix` vaut `FALSE`.

::: callout-warning

```{r}
lazy_eval_1 <-
  function(x = stop("C'est une erreur !"),
           y = matrix(1:9, nrow = -3L)) {
    truc <- x
    TRUE
  }
lazy_eval_2 <-
  function(x = stop("C'est une erreur !"),
           y = matrix(1:9, nrow = -3L)) {
    x
    TRUE
  }
# Essayer lazy_eval_1() et lazy_eval_2()
```

* L'assignation `truc <- x` force l'évaluation de `x`.
* Une ligne avec simplement écrit `x` force l'évaluation de `x`.

C'est pourquoi les deux appels de fonction ci-dessus précipitent une erreur.

:::

```{webr-r}
court_circuit_1 <-
  function(choix) {
    choix && stop("C'est une erreur !")
  }

court_circuit_2 <-
  function(choix) {
    choix || stop("C'est une erreur !")
  }
# Testez
# court_circuit_1(choix = TRUE)
# court_circuit_1(choix = FALSE)
# court_circuit_2(choix = TRUE)
# court_circuit_2(choix = FALSE)
```

On voit ci-dessus que :

* Dans le cas de cas de `court_circuit_1`, le `stop()` n'est pas évalué si choix vaut `FALSE`. En effet, peu importe la valeur du deuxième terme, on peut bien deviner que si le premier est faux, la valeur du `&&` doit être `FALSE`. Pas besoin donc de continuer.
* Dans le cas de cas de `court_circuit_2`, le `stop()` n'est pas évalué si choix vaut `TRUE`. En effet, peu importe la valeur du deuxième terme, on peut bien deviner que si le premier est vrai, la valeur du `||` doit être `TRUE`. Pas besoin donc de continuer.

::: callout-warning

```{webr-r}
pas_court_circuit_1 <-
  function(choix) {
    choix & stop("C'est une erreur !")
  }

pas_court_circuit_2 <-
  function(choix) {
    choix | stop("C'est une erreur !")
  }
# Testez
# pas_court_circuit_1(choix = TRUE)
# pas_court_circuit_1(choix = FALSE)
# pas_court_circuit_2(choix = TRUE)
# pas_court_circuit_2(choix = FALSE)
```

Attention, les opérateurs logiques `&` et `|`, qui sont normalement prévus pour de la logique vectorielle, ne sont pas court-circuités comme on peut le voir dans l'exemple précédent.

:::

## Évaluation standard

On a vu dans le classeur précédent que les appels de fonctions définissent de nouveaux environnements, et que les différents symboles (noms d'objet) utilisés sont évalués en remontant l'arbre des environnements jusqu'à trouver le bon symbole.

On vient également de voir que les expressions sont évaluées au dernier moment, ce que l'on appelle l'évaluation paresseuse. Les expressions sont évaluées dans leur environnement, par exemple celui de leur fonction.

La somme de ces deux propriétés définit l'évaluation standard en R.

R permet cependant des bâtir des exceptions à cette "évaluation standard". On appelle ces évaluations irrégulières des... Évaluations non-standard (Non-Standard Evaluation, NSE).

```{webr-r}
library(disaggR)
exists("disaggR")
```

Lorsque l'on charge un package, par exemple [disaggR](https://github.com/InseeFr/disaggR), on utilise `library()` avec à l'intérieur un symbole qui n'existe pourtant pas dans l'environnement global. Ici l'environnement global ne contient pas d'objet `disaggR`. C'est une forme d'évaluation non-standard puisque library ne réagit pas comme toutes les fonctions de R. Mais bon, ce n'est pas une évaluation non-standard des plus utiles en soi.

La plus utilisée de ces NSE est la tidyeval régnant dans le tidyverse.

## tidyeval : les bases

```{webr-r}
library(dplyr)
exists("height")
exists("name")
dplyr::starwars %>%
  filter(height > 200) %>%
  select(name)

# Rappel : cette syntaxe avec pipe (%>%)
# est équivalente à
# select(filter(dplyr::starwars, height > 200), name)
```

Lorsque l'on exécute le code précédent, on peut se rendre compte que celui-ci n'est pas exécuté par évaluation standard : en effet, le symbole `height` comme le symbole `name` n'existent pas dans l'environnement global. Ils ne remontent pas les environnements. Ils sont évalués *dans le contexte du premier argument*, en l'occurence `dplyr::starwars` pour ce qui est de l'appel à `filter()`, puis `filter(dplyr::starwars, height > 200)` en ce qui concerne l'appel à `select()`.

`dplyr` évite une syntaxe verbieuse et peu lisible. Pour écrire quelque chose de rigoureusement équivalent dans base, on aurait dû écrire le code ci-dessous (on a rajouté `! is.na()` car `filter()` enlève les `NA` par défaut, et `drop = FALSE` car sinon R convertit les data.frame d'une seule unique colonne en vecteur).

```{webr-r}
starwars_df <- as.data.frame(dplyr::starwars) # Juste une ligne pour obtenir le tibble au format data.frame de base
starwars_df[starwars_df$height > 200 &
              ! is.na(starwars_df$height > 200),
            "name",
            drop = FALSE]
```

La tidyeval aide à cette syntaxe plus légère. En effet, dans dplyr, on n'a pas à répéter systématiquement qu'on se trouve dans le tibble `starwars`. C'est implicite ! Les arguments de `filter()` et `select()` sont tous deux évalués dans le contexte de starwars.

## tidyeval : comportement des expressions et des quosures 

Lorsque l'on donne pour argument `height > 200` à dplyr, cela ressemble à ce que l'on a vu plus haut, une expression. En réalité, le tidyverse utilise des **quosures**, une notion similaire aux expressions mais au comportement différent.

```{webr-r}
height <- "un truc qui ne sera lu par aucune evaluation"
x <- 2
ma_quosure <- rlang::quo(x * height)
mon_expression <- quote(x * height)
quosure_resultat <- function(quo) {
  x <- 1
  rlang::eval_tidy(quo, data = dplyr::starwars)
}
expression_resultat <- function(expr) {
  x <- 1
  eval(expr, envir = dplyr::starwars)
}
quosure_resultat(ma_quosure)
expression_resultat(mon_expression)
```

On voit ici que l'évaluation de `x * height` n'est pas interprétée de la même manière selon que l'on définisse une quosure ou une expression. On note deux choses :

* **`height` est évalué de la même manière** dans les deux cas. Elles cherchent tout d'abord dans la donnée qui leur est spécifiée, à savoir `dplyr::starwars`. Dans la mesure où le symbole `height` existe dans ces données, aucune n'a besoin d'aller voir ailleurs.
* Par contre, **l'évaluation de `x` est différente**. Dans le cas de l'expression, puisque le symbole n'existe pas dans `dplyr::starwars`, l'évaluation standard va dérouler les environnements à partir de l'environnement d'*appel du `eval`*. Ici on trouve directement une valeur, le `1`. Et hop ! À contrario, la quosure va dérouler les environnements à partir de l'environnement de création de la quosure. C'est pour cela que x vaut 2.

::: callout-important

## Important : Ce n'est pas une distinction futile !

Cela peut sembler futile, mais cette particularité rend l'utilisation de quosure beaucoup plus sécurisée et moins surprenante à l'utilisateur. L'utilisateur n'est pas censé connaitre le code interne des fonctions qu'il utilise (`filter`, etc.). Si celles-ci évaluaient bêtement les expressions, imaginons que leur code interne contienne une variable `x`, et que l'utilisateur évalue une expression avec un `x`, il y aurait conflit quand bien même celui-ci aurait défini un `x` dans l'environnement global. Ce n'est vraisemblablement pas ce que l'utilisateur attend.

:::

## tidyeval : sous le chapeau des quosures

Lorsque l'on définit une quosure, on ne définit en fait rien de plus qu'un couple entre une expression et l'environnement d'appel.

```{webr-r}
height <- "un truc qui ne sera lu par aucune evaluation"
x <- 2
ma_quosure <- rlang::quo(x * height)
ma_quosure
```

Si j'affiche en effet le contenu de `ma_quosure`, je vois que celle-ci contient deux éléments :

* L'expression `x * height`
* Un lien vers l'environnement global

C'est cet environnement global qui permet, lors de la tidyeval, de remonter au bon environnement.

Un comportement tout-à-fait équivalent à celui des quosures est possible avec des expressions, mais il faut alors spécifier **une expression et un environnement**.

```{webr-r}
height <- "un truc qui ne sera lu par aucune evaluation"
x <- 2
ma_quosure <- rlang::quo(x * height)
mon_expression <- quote(x * height)
quosure_resultat <- function(quo) {
  x <- 1
  rlang::eval_tidy(quo, data = dplyr::starwars)
}
expression_resultat <- function(expr, envir) {
  x <- 1
  eval(expr, envir = dplyr::starwars, enclos = envir)
}
quosure_resultat(ma_quosure)
expression_resultat(mon_expression, environment())
```

On a rajouté ci-dessus à `eval()` un argument `enclos` qui spécifie le lieu où les symboles qui ne sont pas trouvés dans les données de `envir` vont être évaluées. Grâce à cela, l'évaluation de `x` se fait par rapport à la variable de l'environnement global dans les deux cas !

La quosure n'est autre qu'une expression complétée par un environnement de closure, d'où son nom.

## tidyeval : évaluation avec le bang (`!!`) !

On a donc vu les :

* **symboles** (également appelés *noms*), les mots désignant des objets à évaluer dans des environnements.
* **quosures**, un couple entre expression et environnement d'appel.

L'usage intensif de ces éléments est une caractéristique particulière de la programmation dans le tidyverse, particulièrement dans dplyr.

```{webr-r}
library(dplyr)
x <- 200
filtre_et_select <- function(tbl, filtre, colonne_selection) {
  filtre <- enquo(filtre)
  colonne_selection <- ensym(colonne_selection)
  tbl %>%
    filter(!! filtre) %>%
    select(!! colonne_selection)
}
filtre_et_select(dplyr::starwars,
                 height > x,
                 name)
```

Dans l'exemple ci-dessus, on a programmé avec dplyr ! On a fait une fonction à qui on peut suggérer un `filtre` et un nom de colonne (sous la forme d'un *symbole*), et ces éléments vont être évalués dans le contexte des données de `tbl`.

Comment est-ce que cela fonctionne ? L'idée de base est que `enquo()` et `ensym()` empêchent l'évaluation (sous la forme d'une quosure et d'un symbole, respectivement), tandis que les bang `!!` vont au contraire demander *évalue-moi cela ici*.

Plus spécifiquement, avec le couple `arg <- enquo(arg)` / `!!`, on va :

* Éviter l'évaluation d'un argument et le transformer en objet de type quosure s'il n'est pas déjà une quosure, en enfermant l'environnement parent.
* S'il est déjà une quosure, il va passer la quosure telle quelle, en conservant l'environnement déjà enfermé dedans.

De cette manière, d'appel de fonction en appel de fonction, on transmet l'environnement dans lequel la quosure a été effectivement saisie (ici `height > x`) .

Ici, il n'y a qu'un unique appel de fonction. L'environnement contenu dans la quosure transmise à filter n'est autre que l'environnement global dans lequel le `x` peut s'évaluer.

L'effet  du couple `arg <- ensym(arg)` / `!!` est plus simple puisque les symboles n'enferment pas de lien à un environnement :

* On évite l'évaluation du symbole avec `ensym()`
* On dit de l'évaluer avec `!!` dans une nouvelle fonction (qui à son tour peut en fait stopper l'évaluation avec un nouveau `ensym()` et la passer à nouveau  plus bas avec `!!`)

```{webr-r}
library(dplyr)
x <- 200
filtre_et_summarise <- function(tbl, filtre, nom_summarise, calcul_summarise) {
  filtre <- enquo(filtre)
  calcul_summarise <- enquo(calcul_summarise)
  nom_summarise <- ensym(nom_summarise)
  tbl %>%
    filter(!! filtre) %>%
    summarise(!! nom_summarise := !! calcul_summarise)
}
filtre_et_summarise(dplyr::starwars,
                    height > x,
                    nouveau_nom,
                    x * sum(height))
# Le calcul ci-dessus vaut bien la même chose que
# starwars %>% filter(height > 200) %>% summarise(nouveau_nom = x * sum(height))
```

On voit ci-dessus que l'on peut même utiliser les bang `!!` avant le `=` dans une fonction qui utilise des `=` comme summarise. Mais il faut alors modifier le `=` par un `:=` pour que ça marche.

::: callout-tip

Il existe un raccourci pour `enquo()` et `!!` qui allège un peu, mais est sans doute un peu moins clair et ne permet pas de faire une distinction entre symboles et quosures. On aurait pu écrire :


```{webr-r}
library(dplyr)
x <- 200
filtre_et_summarise <- function(tbl, filtre, nom_summarise, calcul_summarise) {
  tbl %>%
    filter({{filtre}}) %>%
    summarise({{nom_summarise}} := {{calcul_summarise}})
}
filtre_et_summarise(dplyr::starwars,
                    height > x,
                    nouveau_nom,
                    x * sum(height))
```

Cela à l'avantage d'être plus succinct ; cela a le désavantage d'être moins explicite. C'est au choix.

:::

## tidyeval : dots et bang bang (`!!!`) !

Parfois, on a besoin non pas d'un seul argument symbole/quosure mais d'un nombre indéfini. Des variantes de `enquo()` et `ensym()` existent au pluriel. Ces variantes sont `enquos()` et `ensyms()` et s'utilisent avec l'opérateur `!!!`.

```{webr-r}
library(dplyr)
x <- 200
filtre_et_select <- function(tbl, filtre, ...) {
  filtre <- enquo(filtre)
  colonnes_selection <- ensyms(...)
  tbl %>%
    filter(!! filtre) %>%
    select(!!! colonnes_selection)
}
filtre_et_select(dplyr::starwars,
                 height > x,
                 name, height)
```

Tout d'abord, l'exemple ci-dessus reprend le filtre_et_select mais en acceptant plusieurs sélections dans les dots, car on a utilisé `ensyms()`. On a donc de manière conjointe utilisé `!!!`.

```{webr-r}
library(dplyr)
x <- 200
filtre_et_select <- function(tbl, colonne_selection, ...){
  filtres <- enquos(...)
  colonne_selection <- ensym(colonne_selection)
  tbl %>%
    filter(!!! filtres) %>%
    select(!! colonne_selection)
}
filtre_et_select(dplyr::starwars,
                 name,
                 height > x,
                 height < 230)
```

Inversement, dans ce dernier exemple, on a laissé la possibilité de spécifier plusieurs filtres en utilisant `enquos()` et en les faisant évaluer par `!!!` dans le `filter()`.

::: callout-tip

Les `!!!` passent aussi les noms d'arguments dans les `...`, donc sont aussi solubles avec les fonctions de type `rename` ou `summarise`.

:::

## Exercices

### Exercice 1

Écrire une fonction `filtre_et_summarise` de la forme `function(tbl, filtre, ...)` et qui :

* applique le filtre fourni sur le tibble.
* puis passe à summarise les éléments du `...`.

```{webr-r}
# Vous pouvez faire l'exercice ici.
```

::: {.callout-tip collapse="true"}

## Proposition de solution

```{webr-r}
library(dplyr)
x <- 200
filtre_et_summarise <- function(tbl, filtre, ...) {
  filtre <- enquo(filtre)
  summar <- enquos(...)
  tbl %>%
    filter(!! filtre) %>%
    summarise(!!! summar)
}
filtre_et_summarise(dplyr::starwars,
                    height > x,
                    sum_height = sum(height, na.rm = TRUE),
                    mean_mass = mean(mass, na.rm = TRUE),
                    compte = n())
```

:::

### Exercice 2

On souhaite écrire une fonction `faire_taux(tbl, ...)` qui prend dans les `...` des conditions booléennes et retourne des taux avec les mêmes noms que ceux des arguments fournis.

Par exemple, dans :

```{r}
#| include: false
library(dplyr)
```

```{r}
#| echo: false
tbl <-
  tibble(moyen = c("voiture", "voiture", "voiture", "train"),
         prenom = c("arnaud", "arnaud", "raphael", "arnaud"),
         bonjour = c(FALSE, FALSE, FALSE, TRUE))
```

```{r}
#| eval: false
tbl %>%
  faire_taux(hello = moyen == "voiture" & prenom == "arnaud",
             super = bonjour & moyen == "voiture",
             bonjour = bonjour)
```

doit retourner :

```{r}
#| echo: false
library(dplyr)
tibble(hello = 0.5,
       super = 0,
       bonjour = 0.25)
```

```{webr-r}
# Vous pouvez faire l'exercice ici.
```

::: {.callout-tip collapse="true"}

## Aide 1 (optionnel)

On pourra s'aider d'une première étape de pipe avec `transmute`. `transmute` ressemble à `mutate` mais abandonne toutes les colonnes non-transformées.

:::

::: {.callout-tip collapse="true"}

## Aide 2 (optionnel mais à ne pas consulter avant minimum 15 minutes de brainstorming !)

Penser à `across()` qui permet d'appliquer, dans un `mutate()`, un `transmute()` ou un `summarise()`, une fonction à plusieurs colonnes en même temps.

:::

::: {.callout-tip collapse="true"}

## Proposition de solution

```{webr-r}
library(dplyr)

tbl <-
  tibble(moyen = c("voiture", "voiture", "voiture", "train"),
         prenom = c("arnaud", "arnaud", "raphael", "arnaud"),
         bonjour = c(FALSE, FALSE, FALSE, TRUE))

faire_taux <- function(tbl, ...) {
  summar <- enquos(...)
  tbl %>%
    transmute(!!! summar) %>%
    summarise(across(everything(), ~sum(as.numeric(.x))/n()))
}

tbl %>%
  faire_taux(hello = moyen == "voiture" & prenom == "arnaud",
             super = bonjour & moyen == "voiture",
             bonjour = bonjour)
```

:::

### Exercice 3

Dans la partie précédente, on a vu comment on peut faire un compteur avec des closures.

On avait :

```{r}
#| eval: false
nouveau_compteur <-
  function() {
    n <- 0L
    function() {
      n <<- n + 1L
      return(n)
    }
  }

compteur <- nouveau_compteur()
compteur()
compteur()
compteur()
```

On veut maintenant modifier ce compteur, de sorte à pouvoir permettre des enchaînements d'incrémentations.

```{r}
#| eval: false
compteur$
  suivant()$
  suivant()$
  suivant()
```

doit incrémenter 3 fois l'état interne, mais ne doit pas en afficher sa valeur.

```{r}
#| eval: false
compteur$get()
```

doit afficher la valeur de l'état interne (donc `3` après 3 incrémentations).

Pour cela, on va, comme on l'a vu au chapiter précédent, utiliser une liste de fonctions. Et on doit aussi utiliser la propriété de R d'évaluation au temps d'exécution. Complétez le modèle suivant de sorte à obtenir les bons résultats.

```{webr-r}
nouveau_compteur <-
  function() {
    n <- 0L
    this <-
      list(
        suivant = function() {
          # A remplir
        },
        get = function() {
          # A remplir
        }
      )
    this
  }

compteur_1 <- nouveau_compteur()
compteur_2 <- nouveau_compteur()
compteur_1$
  suivant()$
  suivant()$
  suivant()
compteur_1$get() # doit afficher 3
compteur_2$get() # doit afficher 0
compteur_1$suivant()
compteur_2$suivant()
compteur_1$get() # doit afficher 4
compteur_2$get() # doit afficher 1
```

::: {.callout-tip collapse="true"}

## Proposition de solution

```{r}
nouveau_compteur <-
  function() {
    n <- 0L
    this <-
      list(
        suivant = function() {
          n <<- n + 1L
          this
        },
        get = function() {
          n
        }
      )
    this
  }

compteur_1 <- nouveau_compteur()
compteur_2 <- nouveau_compteur()
compteur_1$
  suivant()$
  suivant()$
  suivant()
compteur_1$get() # doit afficher 3
compteur_2$get() # doit afficher 0
compteur_1$suivant()
compteur_2$suivant()
compteur_1$get() # doit afficher 4
compteur_2$get() # doit afficher 1
```

Le code ci-dessus peut sembler étonnant ; this est en quelque-sorte auto-référentiel. Mais :

* Au moment où `nouveau_compteur()` s'exécute, R se moque de savoir si la fonction anonyme sous `suivant` a un sens.
* Au moment où `nouveau_compteur()` retourne, `this` existe dans l'environnement de l'instance considérée.
* `suivant()` est ne peut être appelé qu'après le retour de `nouveau_compteur()` donc this existe bel et bien.

:::

### Exercice 4

On souhaite produire une fonction `get_variables(df, ...)` qui retourne une **liste nommée** de tibbles. Les `...` correspondent à des symboles et on doit, pour chaque symbole `nom_symbole`, faire un `count(df, nom_symbole)` puis rajouter une colonne `pct` qui correspond aux tris à plat selon les modalités de cette colonne. On a donc :

* Chaque nom de la liste correspond à un symbole des `...`.
* Chaque élément de la liste correspond à un tibble avec trois colonnes (`nom_symbole`, `n` et `pct`).

Par exemple, `get_variables(dplyr::starwars, eye_color, skin_color)` doit retourner :

```{r}
#| echo: false
library(dplyr)

get_variables <- function(df, ...) {
  variables <- ensyms(...)
  res <-
    lapply(variables, function(x) {
      df %>%
        count(!! x) %>%
        mutate(pct = n / sum(n) * 100) %>%
        mutate(pct = round(pct, 1))
    })
  names(res) <- as.character(variables)
  res
}

dplyr::starwars %>%
  get_variables(eye_color, skin_color)
```

On pourra utiliser une propriété : ce qui est retourné par `ensyms()` est en fait une *liste de symboles*, susceptible d'être manipulée en tant que telle.

```{webr-r}
# Vous pouvez faire l'exercice ici.
```

::: {.callout-tip collapse="true"}

## Aide  (optionnel mais à ne pas consulter avant minimum 15 minutes de brainstorming !)

```{r}
#| eval: false
get_variables <- function(df, ...) {
  variables <- ensyms(...)
  res <-
    lapply(variables, function(x) {
      # remplir ici
    })
  names(res) <- as.character(variables)
  res
}

dplyr::starwars %>%
  get_variables(eye_color, skin_color)
```

:::

::: {.callout-tip collapse="true"}

## Proposition de solution

```{r}
library(dplyr)

get_variables <- function(df, ...) {
  variables <- ensyms(...)
  res <-
    lapply(variables, function(x) {
      df %>%
        count(!! x) %>%
        mutate(pct = n / sum(n) * 100) %>%
        mutate(pct = round(pct, 1))
    })
  names(res) <- as.character(variables)
  res
}

dplyr::starwars %>%
  get_variables(eye_color, skin_color)
```

:::