R - Shiny

class: center, middle, inverse, title-slide

# L’Extension : Shiny
## Premiers Pas
### Mickaël Canouil, Ph.D. (<a href="http://mickael.canouil.fr/" target="_blank"> mickael.canouil.fr</a>)
### Dernière mise à jour : 08-10-2021

---

class: part-slide

@-webkit-keyframes glow {
  from {
    /*text-shadow: 0 0 10px #fff, 0 0 20px #fff, 0 0 30px #1b81e5, 0 0 40px #1b81e5, 0 0 50px #1b81e5, 0 0 60px #1b81e5, 0 0 70px #1b81e5;*/
  }
  to {
    text-shadow: 0 0 20px #a9a9a9, 0 0 30px #a9a9a9, 0 0 40px #a9a9a9, 0 0 50px #a9a9a9;
  }
}

img {
  box-shadow: 3px 5px 3px 1px #33333380;
}

.part-slide img {
 box-shadow: none;
}
</style>

# Diapositives et matériel [ mcanouil/rshiny](https://github.com/mcanouil/rshiny/)

---
class: part-slide

# Préparer sa session

---

# Trucs et astuces

* Eviter de changer votre répertoire de travail avec `setwd()`.
* Ne pas utiliser de `.Rprofile` modifiant .
* Désactiver la conversion automatique en facteurs `options(stringsAsFactors = FALSE)` ( < 4.0).
* Ne pas utiliser `rm(list = ls())` pour "rafraichir".
* Ne pas utiliser la sauvegarde/restauration par défaut de .

.pull-left[
.center[
![](data:image/png;base64,#content/media/rstudio_setup.png)
]
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/rwindows_setup.png)
]
]

---
class: part-slide

# Qu'est-ce que Shiny ? <img src = "data:image/png;base64,#https://raw.githubusercontent.com/rstudio/hex-stickers/master/SVG/shiny.svg", width = "216px" />

---

# Avant Shiny ...

Il était nécessaire de connaître/maîtriser :

* **HTML**, pour concevoir des pages (statique) web.

* **CSS**, pour ajouter du _style_ à une page HTML.

* **JavaScript**, pour effectuer des "calculs" au sein d'une page HTML (via un navigateur).

---

# Shiny

Shiny est une extension permettant la création d'application web interactive directement depuis .

* Page internet.

* Documents (R Markdown) interactifs.

* Tableaux de bords.

Les applications Shiny sont compatibles avec :

* CSS.

* "html widgets".

* JavaScript.

---

# Installation & Chargement

La version stable de Shiny peut se télécharger sur le CRAN.

```r
install.packages("shiny")
```

La version en développement est disponible sur GitHub .

```r
if (!require("remotes")) install.packages("remotes")
remotes::install_github("rstudio/shiny")
```

Charger Shiny dans sa session .

```r
library("shiny")
```

---

# Composantes d'une application Shiny

+ L'extension Shiny.
    
    ```r
    library("shiny")
    ```

+ Une interface (`ui`, *c.-à-d.*, "user interface").
 
 ```r
 ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")
 ```

+ Une fonction serveur (`server`).
 
 ```r
 server <- function(input, output, session) { }
 ```

+ La construction d'un objet "Shiny app".
    
    ```r
    shinyApp(ui, server)
    ```

???

App [`"content/scripts/00-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/00-app/app.R)

---

# Composantes d'une application Shiny

L'application Shiny peut être démarrée par simple exécution.

```r
library("shiny")

ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")

server <- function(input, output, session) { }

shinyApp(ui, server)
```

???

App [`"content/scripts/00-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/00-app/app.R)

---

# Composantes d'une application Shiny

Ou via un script `app.R`, placé dans un répertoire portant généralement le nom de l'application.

```{}
content/scripts/00-app
\-- app.R
```

```r
library("shiny")

ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")

server <- function(input, output, session) { }

shinyApp(ui, server)
```

```r
runApp("content/scripts/00-app")
```

???

App [`"content/scripts/00-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/00-app/app.R)

---

# Composantes d'une application Shiny

Une fois l'application démarrée, vous devriez voir une fenêtre s'ouvrir.

```r
runApp("content/scripts/00-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

.center[
![](data:image/png;base64,#content/media/00.png)
]

* URL par défaut (hôte)

* Port défini au hasard

* Console R "occupée"

* Bouton "stop"

* `Ctrl`+ `c`

* Fermer la fenêtre de l'application

???

App [`"content/scripts/00-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/00-app/app.R)

---

# L'interface `ui`

* `fluidPage()`, la fonction gérant la structure de la page internet ("responsive web design").

```r
ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")
```

Pour ajouter des contrôles (`*Input()`).

* `textInput()`, la fonction gérant un champ de saisie de texte.

```r
  textInput(inputId = "name", label = "Nom", value = "default")
```

```r
ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default")
)
```

???

App [`"content/scripts/01-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/01-app/app.R)

---

# L'interface `ui`

Les contrôles (`*Input()`) nativement disponibles :

.pull-left[

* `checkboxGroupInput()`

* `checkboxInput()`

* `dateInput()`

* `dateRangeInput()`

* `fileInput()`

* `numericInput()`

]

.pull-right[

* `passwordInput()`

* `selectInput()`

* `selectizeInput()`

* `sliderInput()`

* `textAreaInput()`

* `textInput()`

]

---

# L'interface `ui`

```r
runApp("content/scripts/01-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

.center[
![](data:image/png;base64,#content/media/01.png)
]

???

App [`"content/scripts/01-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/01-app/app.R)

---

# Le serveur `server`

Notre application ne contient aucune action serveur (`server`).

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default")
)

server <- function(input, output, session) { }

shinyApp(ui, server)
```

???

App [`"content/scripts/01-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/01-app/app.R)

---

# Le serveur `server`

* Du `server` à `ui` &rarr; `output`.

```r
server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}
```

```r
output$id <- renderTYPE({
 # Une expression générant la sortie de type "TYPE"
})
```

* Partie _gauche_ : objet (`output`) renvoyé vers l'interface (`ui`) avec un identifiant unique (`id`).

* Partie _droite_ : fonction spécifique pour générer la sortie qui pourra être affichée dans l'interface (`ui`).

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---

# Le serveur `server`

Les fonctions `render*()` nativement disponibles :

.pull-left[

* `renderCachedPlot()`

* `renderDataTable()`

* `renderImage()`

* `renderPlot()`

]

.pull-right[

* `renderPrint()`

* `renderTable()`

* `renderText()`

* `renderUI()`

]

---

# Le serveur `server`

* Du `server` à `ui` &rarr; `output`.

```r
server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}
```

* `textOutput()`, la fonction gérant l'affichage des éléments construits par le serveur (`server`).

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default"),
 textOutput(outputId = "hello_message")
)

server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}

shinyApp(ui, server)
```

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---

# Première application Shiny

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default"),
 textOutput(outputId = "hello_message")
)

server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}

shinyApp(ui, server)
```

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---

# Première application Shiny

```r
runApp("content/scripts/02-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

.center[
![](data:image/png;base64,#content/media/02.png)
]

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---
class: part-slide

# Shiny Les entrées `input`

---

# Les `input` en détails

Contraintes sur les valeurs de `inputID` :

* Doit être unique.

* Chaîne de caractères alphanumériques et "underscores".

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---

# `input` de type texte

```r
ui <- fluidPage(
 textInput("name", "Nom"),
 passwordInput("password", "Mot de passe"),
 textAreaInput("description", "Description", rows = 3)
)
```

.center[
![](data:image/png;base64,#content/media/03.png)
]

???

App [`"content/scripts/03-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/03-app/app.R)

---

# `input` de type numérique

```r
ui <- fluidPage(
 numericInput("num1", "Nombre 1", value = 0, min = 0, max = 100),
 sliderInput("num2", "Nombre 2", value = 42, min = 0, max = 100),
 sliderInput("rng", "Gamme", value = c(7, 42), min = 0, max = 100)
)
```

.center[
![](data:image/png;base64,#content/media/04.png)
]

???

App [`"content/scripts/04-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/04-app/app.R)

---

# `input` de type date

```r
ui <- fluidPage(
 dateInput("uniq_date", "Date unique"),
 dateRangeInput("period", "Période")
)
```

.center[
![](data:image/png;base64,#content/media/05.png)
]

???

App [`"content/scripts/05-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/05-app/app.R)

---

# `input` de sélection simple

```r
ui <- fluidPage(
 selectInput("letters", "Lettres minuscules", head(letters)),
 radioButtons("letters2", "Lettres majuscules", LETTERS[1:5])
)
```

.center[
![](data:image/png;base64,#content/media/06.png)
]

???

App [`"content/scripts/06-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/06-app/app.R)

---

# `input` de sélection multiple

```r
ui <- fluidPage(
 checkboxInput(
 "bin1", 'Question binaire ("oui" par défaut)', value = TRUE
 ),
 checkboxInput("bin2", 'Question binaire ("non" par défaut)'),
 checkboxGroupInput("letters3", "Plusieurs Lettres", LETTERS[5:1])
)
```

.center[
![](data:image/png;base64,#content/media/07.png)
]

???

App [`"content/scripts/07-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/07-app/app.R)

---

# `input` d'action

```r
ui <- fluidPage(
 fileInput("upload", NULL),
 actionButton("click", "Cliquez ici !", icon = icon("mouse-pointer")),
 p( actionLink("click", "Cliquez ici !", icon = icon("home")) )
)

server <- function(input, output, session) { }
```

.center[
![](data:image/png;base64,#content/media/08.png)
]

.footnote[
Note : `icon()` utilise la bibliothèque d'icônes [Font Awesome](https://fontawesome.com/).
]

???

App [`"content/scripts/08-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/08-app/app.R)

---

# Mise en pratique

.pull-left[

* Essayez les différents `input` en jouant sur les arguments.

* Créez un formulaire : nom, prénom, age, sexe, loisirs (choix multiples).

]

.pull-right[

]

???

App [`"content/scripts/09-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/09-app/app.R)

---

# Mise en pratique

.pull-left[

* Essayez les différents `input` en jouant sur les arguments.

* Créez un formulaire : nom, prénom, age, sexe, loisirs (choix multiples).

```r
ui <- fluidPage(
 textInput("lastname", "Nom", value = ""),
 textInput("firstname", "Prénom", value = ""),
 numericInput("age", "Age", value = 0),
 radioButtons("sex", "Sexe",
 choices = c("Femme", "Homme", "Ne sait pas"),
 selected = "Ne sait pas"
 ),
 checkboxGroupInput("hobbies", "Loisirs",
 choices = c(
 "Vélo", "Rando", "Natation",
 "Badminton", "Autres"
 )
 )
)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/09.png)
]
]

???

App [`"content/scripts/09-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/09-app/app.R)

---
class: part-slide

# Shiny Les sorties `output`

---

#  Les `output` en détails

```r
 output$hello_message <- renderText("Bonjour")
```

Contraintes sur les valeurs de `outputId` :

* Doit être unique.

* Chaîne de caractères alphanumériques et "underscores".

???

App [`"content/scripts/02-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/02-app/app.R)

---

# `output` de type texte

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textOutput("text"),
 verbatimTextOutput("code")
)

server <- function(input, output, session) {
 output$text <- renderText({
 "Bonjour, vous êtes sur une application Shiny !"
 })

output$code <- renderPrint({
 summary(rnorm(10))
 })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/10.png)
]
]

???

App [`"content/scripts/10-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/10-app/app.R)

---

# `output` de type texte

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textOutput("text"),
 textOutput("code")
)

server <- function(input, output, session) {
 output$text <- renderText({
 "Du texte"
 })

output$code <- renderPrint({
 "Du code"
 })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/11.png)
]
]

???

App [`"content/scripts/11-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/11-app/app.R)

---

# `output` de type texte

```r
library("shiny")

ui <- fluidPage(
 verbatimTextOutput("text"),
 verbatimTextOutput("code")
)

server <- function(input, output, session) {
 output$text <- renderText({
 summary(rnorm(10))
 })

output$code <- renderPrint({
 summary(rnorm(10))
 })
}

shinyApp(ui, server)
```

.center[
![](data:image/png;base64,#content/media/12.png)
]

???

App [`"content/scripts/12-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/12-app/app.R)

---

# `output` de type tableau statique

```r
library("shiny")

ui <- fluidPage(
 tableOutput("static")
)

server <- function(input, output, session) {
 output$static <- renderTable({
 head(swiss, 5)
 })
}

shinyApp(ui, server)
```

.center[
![](data:image/png;base64,#content/media/13.png)
]

???

App [`"content/scripts/13-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/13-app/app.R)

---

# `output` de type tableau dynamique

```r
library("shiny")

ui <- fluidPage(
 dataTableOutput("dynamic")
)

server <- function(input, output, session) {
 # light DT::renderDataTable
 output$dynamic <- renderDataTable(swiss, options = list(pageLength = 2))
}

shinyApp(ui, server)
```

.center[
![](data:image/png;base64,#content/media/14.png)
]

???

App [`"content/scripts/14-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/14-app/app.R)

---

# `output` de type image (`base`)

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 plotOutput("plot", height = "600px")
)

server <- function(input, output, session) {
 output$plot <- renderPlot(plot(1:5))
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/15.png)
]
]

???

App [`"content/scripts/15-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/15-app/app.R)

---

# `output` de type image (`ggplot2`)

.pull-left[

```r
library("shiny")
library("ggplot2")

ui <- fluidPage(
 plotOutput("plot", height = "600px")
)

server <- function(input, output, session) {
 output$plot <- renderPlot(
 ggplot(mtcars) +
 aes(x = wt, y = mpg) +
 geom_point()
 )
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/16.png)
]
]

???

App [`"content/scripts/16-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/16-app/app.R)

---

# Mise en pratique

.panelset[
  
.panel[.panel-name[Exercice]

1. Créez un formulaire : nom, prénom, age, sexe, loisirs (choix multiples).  
  (*Formulaire généré précedemment*)

2. Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

3. Créez une application affichant un graphique et son code.

]

.panel[.panel-name[Question 1]

* Créez un formulaire : nom, prénom, age, sexe, loisirs (choix multiples).  
  (*Formulaire généré précedemment*)

]

.panel[.panel-name[Question 2 : Code]

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

.pull-left[

```r
ui <- fluidPage(
 textInput("lastname", "Nom", value = "Nom"),
 textInput("firstname", "Prénom", value = "Prénom"),
 textOutput("greetings"),
 numericInput("age", "Age", value = 0),
 radioButtons("sex", "Sexe",
 choices = c("Femme", "Homme", "Ne sait pas"),
 selected = "Ne sait pas"
 ),
 checkboxGroupInput("hobbies", "Loisirs",
 choices = c(
 "Vélo", "Rando", "Natation",
 "Badminton", "Autres"
 )
 )
)
```

]

.pull-right[

```r
server <- function(input, output, session) {
 output$greetings <- renderText({
 sample(c(
 "Bonjour !", "Bienvenue !", "Hello !",
 "Salutations !", "Comment allez-vous ?",
 "Heu, vous êtes qui ?"
 ), 1)
 })
}
```

]

.panel[.panel-name[Question 2 : Application]

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

.center[
<img src = "data:image/png;base64,#content/media/17.png" width = "65%" />
]

]

.panel[.panel-name[Question 3]

* Créez une application affichant un graphique et son code.

.pull-left[
.code60[

```r
library("shiny")

code_for_plot <- "plot(1:10)"

ui <- fluidPage(
 verbatimTextOutput("code"),
 plotOutput("plot", height = "600px")
)

server <- function(input, output, session) {
 output$code <- renderText({
 code_for_plot
 })

output$plot <- renderPlot({
 eval(parse(text = code_for_plot))
 })
}

shinyApp(ui, server)
```
]
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/18.png)
]
]

]

???

App [`"content/scripts/09-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/09-app/app.R)

App [`"content/scripts/17-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/17-app/app.R)

App [`"content/scripts/18-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/18-app/app.R)

---
class: part-slide

# Shiny La mise en page

---

#  La mise en page "sidebar"

.panelset[
  
.panel[.panel-name[Structure]

.center[
<img src = "data:image/png;base64,#content/media/sidebar.png" width = "65%" />
]

]

.panel[.panel-name[Application]

.pull-left.code60[

```r
library("shiny")

ui <- fluidPage(
 titlePanel("Un titre !"),
 sidebarLayout(
 sidebarPanel(
 sliderInput("point", "Point :", min = 0, max = 20, value = 5)
 ),
 mainPanel(
 plotOutput("plot", height = "500px")
 )
 )
)

server <- function(input, output, session) {
 output$plot <- renderPlot(plot(1:10))
}

shinyApp(ui, server)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/19.png)
]
]

]

???

App [`"content/scripts/19-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/19-app/app.R)

---

# La mise en page "multirow"

.panelset[
 
.panel[.panel-name[Structure]
.center[
<img src = "data:image/png;base64,#content/media/multirow.png" width = "55%" />
]
]

.panel[.panel-name[Application]
.pull-left.code60[

```r
library("shiny")

ui <- fluidPage(
 fluidRow(
 column(width = 4,
 sliderInput("point", "Point :", min = 0, max = 20, value = 5)
 ),
 column(width = 8, plotOutput("plot"))
 ),
 fluidRow(
 column(width = 6,
 sliderInput("mean", "Moyenne :", min = 0, max = 2, value = 1)
 ),
 column(width = 6, plotOutput("plot2"))
 )
)

server <- function(input, output) {
 output$plot <- renderPlot(plot(1:10))
 output$plot2 <- renderPlot(plot(density(rnorm(n = 25))))
}

shinyApp(ui, server)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/20.png)
]
]
]

]

???

App [`"content/scripts/20-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/20-app/app.R)

---

# La mise en page "tabset"

.pull-left.code60[

```r
library("shiny")

ui <- navbarPage("App Title",
 tabPanel("Figures",
 tabsetPanel(
 tabPanel("point", plotOutput("plot")),
 tabPanel("Densité", plotOutput("plot2"))
 )
 ),
 tabPanel("Table", tableOutput("desc"))
)

server <- function(input, output) {
 output$plot <- renderPlot(plot(1:10))
 output$plot2 <- renderPlot(plot(density(rnorm(n = 25))))
 output$desc <- renderTable(head(iris))
}

shinyApp(ui, server)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/21.png)
]
]

???

App [`"content/scripts/21-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/21-app/app.R)

---

# La mise en page "dashboard"

.panelset[
  
.panel[.panel-name[Application vierge]
.pull-left[

```r
library("shiny")
library("shinydashboard")

ui <- dashboardPage(
 dashboardHeader(),
 dashboardSidebar(),
 dashboardBody()
)

server <- function(input, output) { }

shinyApp(ui, server)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/22.png)
]
]
]

.panel[.panel-name[Application]
.pull-left.code60[

```r
library("shiny")
library("shinydashboard")

ui <- dashboardPage(
 dashboardHeader(title = "Shiny App"),
 dashboardSidebar(
 textInput("title", "Titre :", value = "Titre"),
 sliderInput("point", "Point :", min = 0, max = 20, value = 5),
 sliderInput("mean", "Moyenne :", min = 0, max = 2, value = 1)
 ),
 dashboardBody(
 fluidRow(
 box(plotOutput("plot"), width = 6),
 box(title = "Density", plotOutput("plot2"), width = 6)
 )
 )
)

server <- function(input, output) {
 output$plot <- renderPlot(plot(1:10))
 output$plot2 <- renderPlot(plot(density(rnorm(n = 25))))
}

shinyApp(ui, server)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/23.png)
]
]
]

]

???

App [`"content/scripts/22-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/22-app/app.R)

App [`"content/scripts/23-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/23-app/app.R)

---

# Mise en pratique

.panelset[
  
.panel[.panel-name[Question 1]

1. Essayez la structure grille avec `fluidPage()`, `fluidRow()`, `fixedRow()` et `column()`.

2. Reproduisez les interfaces suivantes.

.pull-left[
.center[
![](data:image/png;base64,#content/media/24.png)
]
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/25.png)
]
]

]

.panel[.panel-name[Question 2a]

* Reproduisez l'interface suivante.

.pull-left[

```r
ui <- fluidPage(titlePanel("Bienvenue"),
 sidebarLayout(
 sidebarPanel(
 textInput("lastname", "Nom", value = ""),
 textInput("firstname", "Prénom", value = ""),
 numericInput("age", "Age", value = 0),
 ),
 mainPanel(
 tabsetPanel(
 tabPanel("Plot", plotOutput("plot")),
 tabPanel("Code", verbatimTextOutput("code"))
 )
 )
 )
)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/24.png)
]
]

]

.panel[.panel-name[Question 2b]

* Reproduisez l'interface suivante.

.pull-left[

```r
ui <- fluidPage(
 titlePanel("Bienvenue"),
 navlistPanel(
 "Partie A",
 tabPanel("Plot 1", plotOutput("plot1")),
 tabPanel("Code 1", verbatimTextOutput("code1")),
 "Partie B",
 tabPanel("Plot 2", plotOutput("plot2")),
 tabPanel("Code 2", verbatimTextOutput("code2"))
 )
)
```
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/25.png)
]
]

]

???

App [`"content/scripts/24-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/24-app/app.R)

App [`"content/scripts/25-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/25-app/app.R)

---
class: part-slide

# Shiny La face cachée `server`

---

# La fonction `server`

```r
server <- function(
 input,
 output,
 session
) {
 ...
}
```

* `input`, une liste de paramètres d'entrées.
* `output`, une liste d'objets à afficher dans `ui`.
* `session`, environnement relatif à la session,  
    *c.-à-d.*, la connection.

---

# La fonction `server`

* De `ui` au `server` &rarr; `input`.

.pull-left[

```r
ui <- fluidPage(
 textInput(
 inputId = "text",
 label = "Texte : ",
 value = "Du texte par défaut ..."
 ),
 textOutput("text")
)
```

```r
server <- function(input, output, session) {
 output$text <- renderText({
 input$text
 })
}
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/26.png)
]
]

???

App [`"content/scripts/26-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/26-app/app.R)

---

# La liste d'entrées `input`

* `input`, une liste de paramètres d'entrées __non-modifiable__.

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 textOutput("text")
)

server <- function(input, output, session) {
 input$text <- "Du texte par défaut ..."
 output$text <- renderText({ input$text })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/27.png)
]
]

???

App [`"content/scripts/27-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/27-app/app.R)

---

# La liste d'entrées `input`

* `input`, une liste de paramètres d'entrées "__reactive__".

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 p(
 "Le texte saisi est : ",
 textOutput("text", inline = TRUE)
 )
)

server <- function(input, output, session) {
 message("Le texte saisi est : ", input$text)
 output$text <- renderText({ input$text })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/28.png)
]
]

???

App [`"content/scripts/28-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/28-app/app.R)

---

# La liste de sorties `output`

* `output`, une liste __non-modifiable__ d'objets à afficher dans `ui`.

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 textOutput("text")
)

server <- function(input, output, session) {
 output$text <- renderText({ input$text })
 output$text <- "Du texte par défaut ..."
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/29.png)
]
]

???

App [`"content/scripts/29-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/29-app/app.R)

---

# La liste de sorties `output`

* `output`, une liste "__reactive__" d'objets à afficher dans `ui`.

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 p(
 "Le texte saisi est : ",
 textOutput("text", inline = TRUE)
 )
)

server <- function(input, output, session) {
 output$text <- renderText({ input$text })
 message("Le texte saisi est : ", output$text)
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/30.png)
]
]

???

App [`"content/scripts/30-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/30-app/app.R)

---

# La notion de réactivité `reactive`

Les sorties (`output`) sont mises à jour à la volée par Shiny lorsque les entrées (`input`) sont modifiées.

* La fonction `server` renseigne Shiny sur la __façon__ de produire les sorties.

* Shiny "décide" de __quand__ produire les sorties.

* Shiny n'exécute que les morceaux de code __utiles__.

---

# La notion de réactivité `reactive`

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : ", value = "vide"),
 p("Texte 1 : ", textOutput("text", inline = TRUE)),
 p("Texte 2 : ", textOutput("text2", inline = TRUE))
)

server <- function(input, output, session) {
 output$text <- renderText({
 message('Calcul de "text" ...')
 input$text
 })
 output$text1 <- renderText({
 message('Calcul de "text1" ...')
 input$text
 })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/31.png)
]
]

???

App [`"content/scripts/31-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/31-app/app.R)

---

# Les expressions `reactive`

Pourquoi utiliser des expressions `reactive` ?

* Donne à Shiny des informations additionnelles.  
    &rarr; __Limite les répétitions__ de calcul.

* Réduction de la redondance de code.  
    &rarr; __Réduction de la complexité__ de l'application.

* Elles peuvent utiliser indifféremment les `input` et `output`.

* Similaire à `input`.  
    &rarr; Elles peuvent s'utiliser dans `output`.

* Similaire à `output`.  
    &rarr; Elles sont mises à jour au besoin selon `input`.
    
---

# `reactive()` : Exemple

.panelset[

.panel[.panel-name[Interface]

.pull-left[
.code60[

```r
ui <- fluidPage(
 fluidRow(
 column(4,
 "Exemple 1",
 textInput("species1", "Espèce : ", value = "setosa"),
 textInput("col1x", "Axe x : ", value = "Petal.Length"),
 textInput("col1y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point1", height = "250px"))
 ),
 fluidRow(
 column(4,
 "Exemple 2",
 textInput("species2", "Espèce : ", value = "versicolor"),
 textInput("col2x", "Axe x : ", value = "Petal.Length"),
 textInput("col2y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point2", height = "250px"))
 ),
 fluidRow(
 column(12, plotOutput("point12", height = "250px"))
 )
)
```
]
]
.pull-right[
.center[
![](data:image/png;base64,#content/media/32.png)
]
]

]

.panel[.panel-name[Serveur 1]
.code60[

```r
server <- function(input, output, session) {
 output$point1 <- renderPlot({
 ggplot(
 data = iris[iris$Species == input$species1, ],
 mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ) + geom_point()
 })
 output$point2 <- renderPlot({
 ggplot(
 data = iris[iris$Species == input$species2, ],
 mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ) + geom_point()
 })
 output$point12 <- renderPlot({
 p1 <- ggplot(
 data = iris[iris$Species == input$species1, ],
 mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ) + geom_point()
 p2 <- ggplot(
 data = iris[iris$Species == input$species2, ],
 mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ) + geom_point()
 wrap_plots(p1, p2, ncol = 2) +
 plot_annotation(tag_levels = "A")
 })
}
```
]
]

.panel[.panel-name[Serveur 2]
.code60[

```r
server <- function(input, output, session) {
 iris1 <- reactive({ iris[iris$Species == input$species1, ] })
 iris2 <- reactive({ iris[iris$Species == input$species2, ] })

output$point1 <- renderPlot({
 ggplot(iris1()) +
 aes(x = .data[[input$col1x]], y = .data[[input$col1y]]) +
 geom_point()
 })

output$point2 <- renderPlot({
 ggplot(iris2()) +
 aes(x = .data[[input$col2x]], y = .data[[input$col2y]]) +
 geom_point()
 })

output$point12 <- renderPlot({
 p1 <- ggplot(iris1()) +
 aes(x = .data[[input$col1x]], y = .data[[input$col1y]]) +
 geom_point()
 p2 <- ggplot(iris2()) +
 aes(x = .data[[input$col2x]], y = .data[[input$col2y]]) +
 geom_point()
 wrap_plots(p1, p2, ncol = 2) +
 plot_annotation(tag_levels = "A")
 })
}
```
]
]

.panel[.panel-name[Serveur 3]
.code60[

```r
 iris_species1 <- reactive({ iris[iris$Species == input$species1, ] })
 iris_species2 <- reactive({ iris[iris$Species == input$species2, ] })

gg_species1 <- reactive({
 ggplot(data = iris_species1()) +
 aes(x = .data[[input$col1x]], y = .data[[input$col1y]]) +
 geom_point()
 })
 gg_species2 <- reactive({
 ggplot(data = iris_species2()) +
 aes(x = .data[[input$col2x]], y = .data[[input$col2y]]) +
 geom_point()
 })

output$point1 <- renderPlot({ gg_species1() })
 output$point2 <- renderPlot({ gg_species2() })
 output$point12 <- renderPlot({
 wrap_plots(gg_species1(), gg_species2(), ncol = 2) +
 plot_annotation(tag_levels = "A")
 })
}

shinyApp(ui, server)
```
]
]

]

???

App [`"content/scripts/32-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/32-app/app.R)

---

# `eventReactive()` & `observeEvent()`

Execution selon un événement, *p. ex.*, un changement de valeur d'un `input`.

```r
something <- eventReactive(eventExpr = ..., valueExpr = ...)

observeEvent(eventExpr = ..., handlerExpr = ...)
```

* `eventExpr`, une expression ou valeur `reactive`.

* `valueExpr`, une expression similaire à celle fournie dans `reactive()`.

* `handlerExpr`, une expression ne retournant rien (`return()`).

---

# Exemple

.pull-left.code60[

```r
library("shiny")

ui <- fluidPage(
 actionButton("update", "Actualiser"),
 textInput("name", "Prénom : ", value = "Mickaël"),
 p(
 "Résultat `reactive` : ",
 textOutput("hello", inline = TRUE)
 ),
 p(
 "Résultat `eventReactive` : ",
 textOutput("hello_event", inline = TRUE)
 )
)

server <- function(input, output, session) {
 text <- reactive({ paste("Bonjour", input$name, "!") })
 output$hello <- renderText({ text() })

text_event <- eventReactive(input$update, {
 paste("Bonjour", input$name, "!")
 })
 output$hello_event <- renderText({ text_event() })

observeEvent(input$update, {
    message("Mise à jour effectuée !")
  })
}

shinyApp(ui, server)
```
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/35.png)
]
]

???

App [`"content/scripts/35-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/35-app/app.R)

---

# Exemple : "App 35 v2"

.panelset[

.panel[.panel-name[Interface]
.code60[

```r
ui <- fluidPage(
 fluidRow(column(12, actionButton("update", "Actualiser"), offset = 5)),
 fluidRow(
 column(4,
 "Exemple 1",
 textInput("species1", "Espèce : ", value = "setosa"),
 textInput("col1x", "Axe x : ", value = "Petal.Length"),
 textInput("col1y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point1", height = "250px"))
 ),
 fluidRow(
 column(4,
 "Exemple 2",
 textInput("species2", "Espèce : ", value = "versicolor"),
 textInput("col2x", "Axe x : ", value = "Petal.Length"),
 textInput("col2y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point2", height = "250px"))
 ),
 fluidRow(
 column(12, plotOutput("point12", height = "250px"))
 )
)
```
]
]

.panel[.panel-name[Serveur]
.code60[

```r
server <- function(input, output, session) {
 gg_species1 <- eventReactive(input$update, {
 ggplot(iris[iris$Species == input$species1, ]) +
 aes(x = .data[[input$col1x]], y = .data[[input$col1y]]) +
 geom_point()
 })
 gg_species2 <- eventReactive(input$update, {
 ggplot(iris[iris$Species == input$species2, ]) +
 aes(x = .data[[input$col2x]], y = .data[[input$col2y]]) +
 geom_point()
 })

.panel[.panel-name[Application]

.center[
![](data:image/png;base64,#content/media/36.png)
]

]

???

App [`"content/scripts/36-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/36-app/app.R)

---

# Mise en pratique

* Créez un menu défilant à choix unique listant les jeux de données de `datasets` avec `"iris"` par défaut.

* Affichez le `summary()` et `str()` du jeu de données séléctionné.

* Ajoutez des champs numériques `x` et `y`.

* Générez un graphique avec :

- `x` la position de la colonne en abscisse.
    
    - `y` la position de la colonne en ordonnée.

???

App [`"content/scripts/37-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/37-app/app.R)

---

# Mise en pratique

.panelset[
  
.panel[.panel-name[Interface]
.code60[

```r
ui <- fluidPage(
 fluidRow(
 column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"),
 choices = ls("package:datasets"),
 selected = "iris"
 )
 )
 ),
 fluidRow(
 column(6,
 h3("Summary"),
 verbatimTextOutput("summary"),
 h3("Structure"),
 verbatimTextOutput("structure")
 ),
 column(6,
 h3("Plot"),
 numericInput("x", label = h4("X-axis column index"), value = 1),
 numericInput("y", label = h4("Y-axis column index"), value = 2),
 plotOutput("plot")
 )
 )
)
```

]
]

.panel[.panel-name[Serveur]

```r
server <- function(input, output, session) {
 dataset <- reactive({
 get(input$dataset, "package:datasets")
 })
 output$summary <- renderPrint({
 summary(dataset())
 })
 output$structure <- renderPrint({
 str(dataset())
 })
 output$plot <- renderPlot({
 plot(dataset()[, input$x], dataset()[, input$y])
 })
}
```

]

.panel[.panel-name[Application]

.center[
<img src = "data:image/png;base64,#content/media/37.png" width = "48%" />
]

]

???

App [`"content/scripts/37-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/37-app/app.R)

---
class: part-slide

# Shiny Contrôle, Validation & Notifications

---

# Contrôle & Validation

```r
req()
validate()
```

* `req()`, contrôle si un `input` a été défini.

* `validate()`, fonctionne comme un `tryCatch`.

```r
ui <- fluidPage(
 textInput("text", "texte : "),
 textOutput("text")
)
```

???

App [`"content/scripts/38-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/38-app/app.R)

---

# Contrôle & Validation

.pull-left[

```r
server <- function(input, output, session) {
 output$text <- renderText({
 req(input$text)
 paste("Ceci est un texte saisie :", input$text)
 })
}
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/38.png)
]
]

.pull-left[

```r
server <- function(input, output, session) {
 output$text <- renderText({
 validate(need(
 expr = input$text == "texte",
 message = 'Un texte différent de "texte".'
 ))
 paste("Ceci est un texte saisie :", input$text)
 })
}
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/39.png)
]
]

???

App [`"content/scripts/38-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/38-app/app.R)

App [`"content/scripts/39-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/39-app/app.R)

---

# Notifications

* `showNotification()` / `removeNotification()`, affiche un encart de texte.

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 plotOutput("plot", height = "400px")
)

server <- function(input, output, session) {
 output$plot <- renderPlot({
 id <- showNotification(
 ui = "Importation des données ...",
 duration = NULL, closeButton = FALSE
 )
 on.exit(removeNotification(id), add = TRUE)
 Sys.sleep(10)
 plot(1:10)
 })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/40.png)
]
]

???

App [`"content/scripts/40-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/40-app/app.R)

---

# Progression

* `withProgress()` / `setProgress()`, affiche une barre de progression.

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 plotOutput("plot", height = "400px")
)

server <- function(input, output, session) {
 output$plot <- renderPlot({
 withProgress(
 message = "Importation des données ...", {
 for (i in seq_len(10)) {
 Sys.sleep(0.5)
 setProgress(i / 10)
 }
 }
 )
 plot(1:10)
 })
}

shinyApp(ui, server)
```

]

.pull-right[
.center[
![](data:image/png;base64,#content/media/41.png)
]
]

???

App [`"content/scripts/41-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/41-app/app.R)

---

# Mise en pratique

* Reprenez l'application développé précédemment ([`"content/scripts/37-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/37-app/app.R)).

* Ajoutez les contrôles nécessaires pour éviter les erreurs observées

???

App [`"content/scripts/42-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/42-app/app.R)

---

# Mise en pratique

.panelset[

.panel[.panel-name[Fonctions]

```r
need_numeric <- function(data, input) {
 need(
 expr = is.numeric(data[, input]),
 message = paste("Column", input, "is not a numeric!")
 )
}

need_in <- function(data, input) {
 need(
 expr = all(input %in% 1:ncol(data)),
 message = paste("Column", input, "is not available!")
 )
}
```
]
 
.panel[.panel-name[Interface]
.code60[

```r
ui <- fluidPage(theme = shinythemes::shinytheme("cyborg"),
 fluidRow(
 column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"),
 choices = ls("package:datasets"),
 selected = "iris"
 )
 )
 ),
 fluidRow(
 column(6,
 h3("Summary"),
 verbatimTextOutput("summary"),
 h3("Structure"),
 verbatimTextOutput("structure")
 ),
 column(6,
 h3("Plot"),
 numericInput("x", label = h4("X-axis column index"), value = 1),
 numericInput("y", label = h4("Y-axis column index"), value = 2),
 plotOutput("plot")
 )
 )
)
```
]
]

.panel[.panel-name[Serveur]

```r
server <- function(input, output, session) {
 dataset <- reactive({
 req(input$dataset)
 get(input$dataset, "package:datasets")
 })
 output$summary <- renderPrint({ summary(dataset()) })
 output$structure <- renderPrint({ str(dataset()) })
 output$plot <- renderPlot({
 validate(need(
 expr = inherits(dataset(), "data.frame"),
 message = "Not a data.frame!"
 ))
 validate(need_in(dataset(), c(input$x, input$y)))
 validate(
 need_numeric(dataset(), input$x),
 need_numeric(dataset(), input$y)
 )
 plot(dataset()[, input$x], dataset()[, input$y])
 })
}
```
]

.panel[.panel-name[Application]
.center[
<img src = "data:image/png;base64,#content/media/42.png" width = "48%" />
]
]

]

???

App [`"content/scripts/42-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/42-app/app.R)

---
class: part-slide

# Shiny Interface Dynamique

---

# Générer des éléments `ui`

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 textInput("lastname", "Nom :"),
 uiOutput("firstname"),
 uiOutput("age")
)

server <- function(input, output, session) {
 output$firstname <- renderUI({
 textInput("firstname", "Prénom :")
 })

output$age <- renderUI({
 numericInput("age", "Age :", value = 0)
 })
}

shinyApp(ui, server)
```
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/43.png)
]
]

???

App [`"content/scripts/43-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/43-app/app.R)

---

# Affichage conditionnel de `ui`

.pull-left.code60[

```r
library("shiny")

ui <- fluidPage(
 fluidRow(
 column(6, textInput("lastname", "Nom :"), uiOutput("firstname")),
 column(6, uiOutput("input_age"), uiOutput("age"))
 )
)

server <- function(input, output, session) {
 output$firstname <- renderUI({
 req(input$lastname)
 textInput("firstname", "Prénom :")
 })
 output$input_age <- renderUI({
 req(input$firstname)
 selectInput("type", "type", c("slider", "numeric"))
 })
 output$age <- renderUI({
 req(input$type, input$firstname)
 if (input$type == "slider") {
 sliderInput("dynamic", "Age :",
 value = 0, min = 0, max = 99
 )
 } else {
 numericInput("age", "Age :", value = 0)
 }
 })
}

shinyApp(ui, server)
```
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/44.png)
]
]

???

App [`"content/scripts/44-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/44-app/app.R)

---

# Affichage conditionnel de `ui`

.pull-left[
.code60[

```r
library("shiny")

ui <- fluidPage(
 fluidRow(
 column(6, textInput("lastname", "Nom :"), uiOutput("firstname")),
 column(6, uiOutput("input_age"), uiOutput("age"))
 )
)

server <- function(input, output, session) {
 output$firstname <- renderUI({
 req(input$lastname)
 textInput("firstname", "Prénom :")
 })
 output$input_age <- renderUI({
 req(input$firstname)
 selectInput("type", "type", c("slider", "numeric"))
 })
 output$age <- renderUI({
 req(input$type, input$firstname)
 if (is.null(previous_age <- isolate(input$age))) previous_age <- 0
 if (input$type == "slider") {
 sliderInput("age", "Age :",
 value = previous_age, min = 0, max = 99
 )
 } else {
 numericInput("age", "Age :", value = previous_age)
 }
 })
}

shinyApp(ui, server)
```
]
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/45.png)
]
]

???

App [`"content/scripts/45-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/45-app/app.R)

---

# Mettre à jour des `input`

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 numericInput("min", "Minimum", 0),
 numericInput("max", "Maximum", 3),
 uiOutput("n")
)

server <- function(input, output, session) {
 output$n <- renderUI({
 sliderInput(
 inputId = "n",
 label = "n",
 min = input$min,
 max = input$max,
 value = 1
 )
 })
}

shinyApp(ui, server)
```
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/46.png)
]
]

???

App [`"content/scripts/46-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/46-app/app.R)

---

# Mettre à jour des `input`

.pull-left[

```r
library("shiny")

ui <- fluidPage(
 numericInput("min", "Minimum", 0),
 numericInput("max", "Maximum", 3),
 sliderInput("n", "n", min = 0, max = 3, value = 1)
)

server <- function(input, output, session) {
 observeEvent(input$min, {
 updateNumericInput(session, "n", min = input$min)
 })

observeEvent(input$max, {
    updateNumericInput(session, "n", max = input$max)
  })
}

shinyApp(ui, server)
```
]

.pull-right[
.center[
![](data:image/png;base64,#content/media/47.png)
]
]

???

App [`"content/scripts/47-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/47-app/app.R)

---

# Mise en pratique

* Générez l'application suivante.

.center[
![](data:image/png;base64,#content/media/51.png)
]

???

App [`"content/scripts/48-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/48-app/app.R)

App [`"content/scripts/49-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/49-app/app.R)

App [`"content/scripts/50-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/50-app/app.R)

App [`"content/scripts/51-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/50-app/app.R)

---

# Mise en pratique

.panelset[
  
.panel[.panel-name[Code 1]
.pull-left.code50[

```r
library("shiny")
library("dplyr")

ui <- fluidPage(
 column(4,
 sliderInput(
 "Sepal.Length", "Sepal.Length",
 min = min(iris$Sepal.Length), max = max(iris$Sepal.Length),
 value = range(iris$Sepal.Length)
 ),
 sliderInput(
 "Sepal.Width", "Sepal.Width",
 min = min(iris$Sepal.Width), max = max(iris$Sepal.Width),
 value = range(iris$Sepal.Width)
 ),
 sliderInput(
 "Petal.Length", "Petal.Length",
 min = min(iris$Petal.Length), max = max(iris$Petal.Length),
 value = range(iris$Petal.Length)
 ),
 sliderInput(
 "Petal.Width", "Petal.Width",
 min = min(iris$Petal.Width), max = max(iris$Petal.Width),
 value = range(iris$Petal.Width)
```
]
.pull-right.code50[

```r
    ),
    selectInput(
      "Species", "Species",
      choices = unique(iris$Species), selected = unique(iris$Species),
      multiple = TRUE
    )
  ),
  column(8, tableOutput("iris"))
)

server <- function(input, output, session) {
 output$iris <- renderTable({
 dplyr::filter(iris,
 dplyr::between(Sepal.Length, input$Sepal.Length[1], input$Sepal.Length[2]),
 dplyr::between(Sepal.Width, input$Sepal.Width[1], input$Sepal.Width[2]),
 dplyr::between(Petal.Length, input$Petal.Length[1], input$Petal.Length[2]),
 dplyr::between(Petal.Width, input$Petal.Width[1], input$Petal.Width[2]),
 Species %in% input$Species
 )
 })
}
```
]
]

.panel[.panel-name[App 1]
.center[
<img src = "data:image/png;base64,#content/media/48.png", width = "75%" />
]
]

.panel[.panel-name[Code 2a]
.code60[

```r
make_ui <- function(data, var) {
 x <- data[, var]
 if (is.numeric(x)) {
 min_max <- range(x, na.rm = TRUE)
 sliderInput(
 inputId = var,
 label = var,
 min = min_max[1],
 max = min_max[2],
 value = min_max
 )
 } else if (is.character(x) | is.factor(x)) {
 unique_x <- unique(x)
 selectInput(
 inputId = var,
 label = var,
 choices = unique_x,
 selected = unique_x,
 multiple = TRUE
 )
 } else {
 NULL # default
 }
}
```
]
]

.panel[.panel-name[Code 2b]
.code60[

```r
library("shiny")
library("dplyr")

ui <- fluidPage(
 column(4,
 make_ui(iris, "Sepal.Length"),
 make_ui(iris, "Sepal.Width"),
 make_ui(iris, "Petal.Length"),
 make_ui(iris, "Petal.Width"),
 make_ui(iris, "Species")
 ),
 column(8, tableOutput("iris"))
)

server <- function(input, output, session) {
 output$iris <- renderTable({
 filter(.data = iris,
 between(Sepal.Length, input$Sepal.Length[1], input$Sepal.Length[2]),
 between(Sepal.Width, input$Sepal.Width[1], input$Sepal.Width[2]),
 between(Petal.Length, input$Petal.Length[1], input$Petal.Length[2]),
 between(Petal.Width, input$Petal.Width[1], input$Petal.Width[2]),
 Species %in% input$Species
 )
 })
}

shinyApp(ui, server)
```
]
]

.panel[.panel-name[App 2]
.center[
<img src = "data:image/png;base64,#content/media/49.png", width = "75%" />
]
]

.panel[.panel-name[Code 3a]
.pull-left.code60[

```r
filter_var <- function(data_var, input_var) {
 if (is.numeric(data_var)) {
 !is.na(data_var) & # dplyr::between
 data_var >= input_var[1] &
 data_var <= input_var[2]
 } else if (is.character(data_var) | is.factor(data_var)) {
 data_var %in% input_var
 } else {
 TRUE # default
 }
}
```
]
]

.panel[.panel-name[Code 3b]

```r
library("shiny")
library("purrr")

ui <- fluidPage(
 column(4, purrr::map(colnames(iris), ~ make_ui(iris, .x))),
 column(8, tableOutput("iris"))
)

server <- function(input, output, session) {
 output$iris <- renderTable({
 vals <- purrr::map(colnames(iris), ~ filter_var(iris[[.x]], input[[.x]]))
 iris[purrr::reduce(vals, `&`), ]
 })
}

shinyApp(ui, server)
```
]

.panel[.panel-name[App 3]
.center[
<img src = "data:image/png;base64,#content/media/50.png", width = "75%" />
]
]

.panel[.panel-name[Code 4a]
.pull-left.code60[

.panel[.panel-name[Code 4b]
.pull-left.code60[

```r
library("shiny")
library("purrr")

ui <- fluidPage(
 fluidRow(column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"),
 choices = ls("package:datasets"),
 selected = "iris"
 )
 )),
 fluidRow(
 column(4, uiOutput("ui")),
 column(8, tableOutput("iris"))
 )
)
```
]
.pull-right.code60[

```r
server <- function(input, output, session) {
 datasets <- reactive({get(input$dataset, "package:datasets")})
 output$iris <- renderTable({
 validate(need(
 expr = inherits(datasets(), "data.frame"),
 message = 'Not a "data.frame"'
 ))
 vals <- purrr::map(
 .x = colnames(datasets()),
 .f = ~ filter_var(datasets()[[.x]], input[[.x]])
 )
 datasets()[purrr::reduce(vals, `&`), ]
 })
 output$ui <- renderUI({
 validate(need(
 expr = inherits(datasets(), "data.frame"),
 message = 'Not a "data.frame"'
 ))
 purrr::map(colnames(datasets()), ~ make_ui(datasets(), .x))
 })
}

shinyApp(ui, server)
```
]
]

.panel[.panel-name[App 4]
.center[
<img src = "data:image/png;base64,#content/media/51.png", width = "75%" />
]
]

]

???

App [`"content/scripts/48-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/48-app/app.R)

App [`"content/scripts/49-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/49-app/app.R)

App [`"content/scripts/50-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/50-app/app.R)

App [`"content/scripts/51-app"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/51-app/app.R)

---
class: part-slide

# Shiny & Rmarkdown <img src = "data:image/png;base64,#https://raw.githubusercontent.com/rstudio/hex-stickers/master/SVG/rmarkdown.svg", width = "216px" />

---

# Shiny & Rmarkdown

* `rmarkdown::html_document`

```r
rmarkdown::run("content/scripts/52-app/app.Rmd")
```

* `flexdashboard::flex_dashboard`

```r
rmarkdown::run("content/scripts/53-app/app.Rmd")
```

* ...

.footnote[Note : La spécification de `app.Rmd` est obligatoire ici avec `rmarkdown::run()`.]

???

App [`"content/scripts/52-app/app.Rmd"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/52-app/app.Rmd)

App [`"content/scripts/53-app/app.Rmd"`](https://github.com/mcanouil/rshiny/tree/main/content/scripts/53-app/app.Rmd)

---
class: part-slide

# Shiny & Plus ...

---

# Ressources

.font150[

* shiny (https://shiny.rstudio.com/)

* "Mastering Shiny" (https://mastering-shiny.org/)

* "Engineering Production-Grade Shiny Apps" (https://engineering-shiny.org/)

* `shinytest` (https://rstudio.github.io/shinytest/)

* `DT` (https://rstudio.github.io/DT/)

* `learnr` (https://rstudio.github.io/learnr/)

]

---

# Autres Ressources

.font150[

* Blog Rstudio (https://blog.rstudio.com/categories/shiny)

* Groupe des Utilisateurs de R (http://forums.cirad.fr/logiciel-R/)

* Stack Overflow (https://stackoverflow.com/questions/tagged/r)

* R Studio Community (https://community.rstudio.com/)

]

---
class: part-slide

# <img src = "data:image/png;base64,#https://avatars1.githubusercontent.com/u/8896044" height = "150px" id = "picture" />

.center[

<a href = "https://mickael.canouil.fr" target = "_blank"> mickael.canouil.fr</a>

.column[
<a href = "https://www.linkedin.com/in/mickael-canouil/" target = "_blank"> mickael-canouil</a>
]
.column[
<a href = "https://github.com/mcanouil/" target = "_blank"> mcanouil</a>
]
.column[
<a href = "https://twitter.com/mickaelcanouil/" target = "_blank"> @mickaelcanouil</a>
]

]