Exos shiny

Partie 1: Introduction

1.1 Noms réservés

1.2 Inputs

1.3 Réactions

1.4 Les bouts de codes correspondant aux prérequis vont où?

1.5 Et tout ça, ça tourne où?

1.6 Un premier exemple

Vous pouvez copier-coller le code suivant dans un fichier “app.R” sous RStudio.

Remplacez les “___” par les valeurs appropriées et tentez de faire fonctionner l’appli.

library(shiny)

ui <- fluidPage(
        sliderInput("___",
                    "Number of bins:",
                    min = 1,
                    max = 50,
                    value = 30),
       plotOutput("_____")
)

server <- function(input, output) {
    output$___ <- renderPlot({
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$___ + 1)
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
}

shinyApp(ui = ui, server = server)

Partie 2: Inputs et outputs

2.1 xxxInput

library(shiny)

ui <- fluidPage(
    ______(inputId="prenom",
           label="Quel est ton prénom?",
           value="Lise"),
    textOutput("salutation")
)

server <- function(input, output) {
    output$salutation <- renderText({
       x=paste("Salut",input$prenom,"!")
    })
}

shinyApp(ui = ui, server = server)

2.2 Production d’une table

Nous allons maintenant utiliser un jeu de données prenoms. Il est fourni dans un package en développement (rendu disponible sur github [ici] (https://github.com/ThinkR-open/prenoms) et installable si vous avez le package devtools installé sur votre machine). Attention il y a aussi un package prenoms sur le CRAN mais ce n’est pas le même! (celui-là contient des données pour le Quebec…). L’installation de devtools pouvant prendre un peu de temps je vous fournis directement le jeu de données prenoms.RDS.

Si vous avez devtools:

Si vous n’avez pas devtools:

Cette table contient des données sur les prénoms de bébés nés en France métropolitaine entre 1900 et 2019, détaillées par département. Les colonnes sont:

year: l’année, un entier compris entre 1900 et 2019
sex: le sexe, soit “M”, soit “F”
name: le prénom
n: le nombre de naissances dans le département
dpt: le département
prop: la proportion de naissances pour l’année considérée dans le département

Considérez l’appli suivante:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")

ui <- fluidPage(
    textInput(inputId="prenom",
              label="Quel prénom?",
              value="Lise"),
    dataTableOutput("table_name_years")
)

server <- function(input, output) {
    output$___ <- renderDataTable({
    ______    
    })
}

shinyApp(ui = ui, server = server)

Copiez ce code dans app.R sous RStudio et modifiez l’appli de manière à afficher la table correspondant au prénom choisi en input, et montrant le nombre d’occurrences du prénom par année pour l’ensemble de la France (pas par département).

Il faudra remobiliser un peu ce que vous avez appris sur l’usage du package dplyr…

Remarque: c’est peut-être le moment de tester la différence entre tableOutput() et dataTableOutput() si vous le souhaitez…

2.3 Filtre par années min et max

L’appli suivante est la “solution” de l’exercice précédent. Remarquez que l’appel à library() peut se faire depuis la partie “global/global.R” (i.e. avant ui et server). De cette manière, les fonctions de la librairie deviennent accessibles à toutes les parties de l’appli.

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")

ui <- fluidPage(
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),
    dataTableOutput("table_name_years")
)

server <- function(input, output) {
    output$table_name_years <- renderDataTable({
        prenoms %>% 
            filter(name==input$prenom) %>% 
            group_by(year) %>% 
            summarise(n=sum(n)) 
    })
}

shinyApp(ui = ui, server = server)

Copiez cette application dans app.R (dans RStudio).

Voici un exemple de “double-ended slider”. Le fait de rentrer deux valeurs dans “value” rend le slider double.

sliderInput("clicclac",
            "Clic et clac",
            min=1,
            max=20,
            value=c(5,10))

Modifiez l’appli ci-dessus de manière à permettre à l’utilisateur de fixer une année minimale et une année maximale pour la table, par un “double-ended slider”.

Répondez ensuite à cette question:

2.4 Production d’un graphique

Vous vous souvenez de ggplot? (j’espère hein!!). Modifiez le code suivant pour produire un graphique montrant le nombre d’occurrences d’un prénom (en y) par année (en x) pour l’ensemble de la France et pour les années dans l’intervalle choisi.. Les librairies ggplot2, dplyr, et le jeu de données prenoms ont déjà été chargés dans l’environnement.

leprenom="Jean"
lemin=1930
lemax=1960
name_years=prenoms %>%  
 filter(name==leprenom,
        year>=lemin,
        year<=lemax) %>% 
 group_by(year) %>% 
 summarise(n=sum(n))  
ggplot(_____)+
 _______

leprenom="Jean"
lemin=1930
lemax=1960
name_years=prenoms %>%  
 filter(name==leprenom,
        year>=lemin,
        year<=lemax) %>% 
 group_by(year) %>% 
 summarise(n=sum(n))  
ggplot(name_years, aes(x=year,y=n))+
 geom_line()

2.5 renderPlot

Modifiez l’appli ci-dessous de manière à ajouter un graphique montrant le nombre d’occurrences du prénom choisi (en y) par année (en x) pour l’ensemble de la France et pour les années dans l’intervalle choisi.

Il faudra bien sûr modifier le code produisant le graphique pour que le résultat dépende des inputs (input$prenom et input$minmax_year).

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")

ui <- fluidPage(
 textInput(inputId="prenom",
           label="Quel est ton prénom?",
           value="Lise"),   
 sliderInput("minmax_year",
             "années min et max",
             min=1900,
             max=2018,
             value=c(1900,2018)),
 dataTableOutput("table_name_years")
)

server <- function(input, output) {
 output$table_name_years <- renderDataTable({
   name_years=prenoms %>% 
     filter(name==input$prenom,
            year>=input$minmax_year[1],
            year<=input$minmax_year[2]) %>% 
     group_by(year) %>% 
     summarise(n=sum(n))  
 })
}

shinyApp(ui = ui, server = server)

Partie 3: Panels et layouts

3.1 Ajout d’un wellPanel

Voici la solution (ou du moins, une solution) pour l’exercice précédent.

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")

ui <- fluidPage(
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),   
    sliderInput("minmax_year",
                "années min et max",
                min=1900,
                max=2018,
                value=c(1900,2018)),
    dataTableOutput("table_name_years"),
    plotOutput("plot_name_years")
)

server <- function(input, output) {
    output$table_name_years <- renderDataTable({
        prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
    })
    output$plot_name_years <- renderPlot({
        name_years=prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
        ggplot(name_years,aes(x=year,y=n)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année"))
        
    })
}

shinyApp(ui = ui, server = server)

L’appli commence à être un peu chargée, et c’est un peu pénible de devoir scroller pour aller voir le graphique, sous le tableau. Nous allons donc arranger un peu sa disposition.

Copiez la dans app.R dans RStudio.

Faites en sorte que les deux widgets d’input soient dans un même “wellPanel”.

3.2 fluidRow

Voici une solution pour l’exercice précédent:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

ui <- fluidPage(
    wellPanel(
        textInput(inputId="prenom",
                  label="Quel est ton prénom?",
                  value="Lise"),   
        sliderInput("minmax_year",
                    "années min et max",
                    min=1900,
                    max=2018,
                    value=c(1900,2018))
    ), #wellPanel
    dataTableOutput("table_name_years"),
    plotOutput("plot_name_years")
)

server <- function(input, output) {
    output$table_name_years <- renderDataTable({
        name_years=prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
        name_years
    })
    output$plot_name_years <- renderPlot({
        name_years=prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
        ggplot(name_years,aes(x=year,y=n)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année"))
        
    })
}

shinyApp(ui = ui, server = server)

Maintenant, disposez le tableau et le graphique l’un à côté de l’autre. Vous pouvez allouer une largeur moins importante au tableau (qui ne compte que deux colonnes) qu’au graphique.

3.3 Un onglet vers un autre graphique

Alternativement, vous pourriez proposer un autre graphique qui permette de visualiser les effectifs par département plutôt que les effectifs sommés pour l’ensemble de la France métropolitaine.

Voici la solution de l’exercice précédent, si besoin:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

ui <- fluidPage(
  wellPanel(
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),   
    sliderInput("minmax_year",
                "années min et max",
                min=1900,
                max=2018,
                value=c(1900,2018))
  ), #wellPanel
  fluidRow(
    column(width=4,
           dataTableOutput("table_name_years")
    ),#column
    column(width=8,
           plotOutput("plot_name_years")
    )#column
  )#fluidRow
)

server <- function(input, output) {
  output$table_name_years <- renderDataTable({
    name_years=prenoms %>% 
      filter(name==input$prenom,
             year>=input$minmax_year[1],
             year<=input$minmax_year[2]) %>% 
      group_by(year) %>% 
      summarise(n=sum(n))  
    name_years
  })
  output$plot_name_years <- renderPlot({
    name_years=prenoms %>% 
      filter(name==input$prenom,
             year>=input$minmax_year[1],
             year<=input$minmax_year[2]) %>% 
      group_by(year) %>% 
      summarise(n=sum(n))  
    ggplot(name_years,aes(x=year,y=n)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année"))
    
  })
}

shinyApp(ui = ui, server = server)

Rajoutez un “tabsetPanel” à cette appli pour que l’utilisateur puisse naviguer entre le premier graphique (montrant les données sommées pour la France métropolitaine), et l’autre graphique (montrant les données pour l’ensemble des départements).

Puis répondez à cette question:

Partie 4: Fonctions et réactivité

4.1 Ecrire des fonctions

Voici une solution pour l’exercice précédent:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

ui <- fluidPage(
    wellPanel(
        textInput(inputId="prenom",
                  label="Quel est ton prénom?",
                  value="Lise"),   
        sliderInput("minmax_year",
                    "années min et max",
                    min=1900,
                    max=2018,
                    value=c(1900,2018))
    ), #wellPanel
    fluidRow(
        column(width=4,
               dataTableOutput("table_name_years")
        ),#column
        column(width=8,
               tabsetPanel(
                   tabPanel("France",
                            plotOutput("plot_name_years")
                   ),#tabPanel
                   tabPanel("Par dép.",
                            plotOutput("plot_name_years_dep")
                   )#tabPanel
               )#tabsetPanel
        )#column
    )#fluidRow
)

server <- function(input, output) {
    output$table_name_years <- renderDataTable({
        name_years=prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n)) 
        name_years
    })
    output$plot_name_years <- renderPlot({
        name_years=prenoms %>% 
            filter(name==input$prenom,
                   year>=input$minmax_year[1],
                   year<=input$minmax_year[2]) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
        ggplot(name_years,aes(x=year,y=n)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année"))
        
    })
    output$plot_name_years_dep <- renderPlot({
        name_years_dep=prenoms %>% 
            filter(name==input$prenom, 
            filter(year>=input$minmax_year[1],
                   year<=input$minmax_year[2])
        ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année et par département"))
        
    })
}

shinyApp(ui = ui, server = server)

Avez-vous remarqué comme certains morceaux de code sont répétés? Par exemple,

name_years=prenoms %>% 
    filter(name==input$prenom,
           year>=input$minmax_year[1],
           year<=input$minmax_year[2]) %>% 
    group_by(year) %>% 
    summarise(n=sum(n))

Un des principes de base en programmation R, c’est de transformer en fonction tout morceau de code qui est répété au moins 2 ou 3 fois.

Essayez de compléter la fonction suivante pour qu’elle renvoie le tableau des effectifs par année (sommés pour la France métropolitaine) correspondant au prénom et aux années min et max passées en input. Le package dplyr et le jeu de données prenoms sont déjà chargés dans l’environnement.

f_name_years=function(prenom,annee_min,annee_max){
    ___
    ___
    return(___)
}

# Testez votre fonction:
f_name_years("Lise",1950,2000)

f_name_years=function(prenom,annee_min,annee_max){
        name_years=prenoms %>% 
            filter(name==prenom,
                   year>=annee_min,
                   year<=annee_max) %>% 
            group_by(year) %>% 
            summarise(n=sum(n))  
    return(name_years)
}

# Testez votre fonction:
f_name_years("Lise",1980,1985)

4.2 Utiliser une fonction

Maintenant, vous pouvez utiliser cette fonction pour simplifier un peu le code de votre appli.

Reprenez le code de l’appli, définissez-y votre fonction (dans la partie “global”), et utilisez-la…

Puis répondez à la question suivante:

4.3 Enrichir la fonction

L’appli que je vous demandais d’implémenter précédemment devait ressembler à celle-ci:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
    name_years=prenoms %>% 
        filter(name==prenom,
               year>=annee_min,
               year<=annee_max) %>% 
        group_by(year) %>% 
        summarise(n=sum(n)) 
    return(name_years)
}

ui <- fluidPage(
    wellPanel(
        textInput(inputId="prenom",
                  label="Quel est ton prénom?",
                  value="Lise"),   
        sliderInput("minmax_year",
                    "années min et max",
                    min=1900,
                    max=2018,
                    value=c(1900,2018))
    ), #wellPanel
    fluidRow(
        column(width=4,
               dataTableOutput("table_name_years")
        ),#column
        column(width=8,
               tabsetPanel(
                   tabPanel("France",
                            plotOutput("plot_name_years")
                   ),#tabPanel
                   tabPanel("Par dép.",
                            plotOutput("plot_name_year_dep")
                   )#tabPanel
               )#tabsetPanel
        )#column
    )#fluidRow
)

server <- function(input, output) {
    output$table_name_year <- renderDataTable({
        f_name_years(input$prenom,
                     input$minmax_year[1],
                     input$minmax_year[2]) 
    })
    output$plot_name_year <- renderPlot({
        name_years=f_name_years(input$prenom,
                                input$minmax_year[1],
                                input$minmax_year[2]) 
        ggplot(name_years,aes(x=year,y=n)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année"))
        
    })
    output$plot_name_year_dep <- renderPlot({
        name_years_dep=prenoms %>% 
            filter(name==input$prenom) %>% 
            filter(year>=input$minmax_year[1],
                   year<=input$minmax_year[2])
        ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année et par département"))
        
    })
}

shinyApp(ui = ui, server = server)

Le code est légèrement simplifié par l’usage de la fonction f_name_years() mais tant qu’à faire j’aimerais également pouvoir me servir de cette fonction pour le deuxième graphique (celui par département)…

Reprenons donc la fonction f_name_years(). J’aimerais que vous la modifiiez de manière à pouvoir l’utiliser pour produire le deuxième graphique (celui où on affiche les résultats par département). Vous pourriez par exemple ajouter un nouvel argument par_departement, qui, s’il est vrai, implique que l’on obtient les résultats par département plutôt que pour l’ensemble de la France métropolitaine.

Modifiez le code de la fonction dans ce sens (dplyr et le jeu de données prenoms ont déjà été chargés dans l’environnement):

f_name_years=function(prenom,annee_min,annee_max){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max) %>% 
    group_by(year) %>% 
    summarise(n=sum(n))  
  return(name_years)
}

# Testez votre fonction:
f_name_years("Lise",1980,1985)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max)
  if(!par_departement){ 
    name_years=name_years %>% 
      group_by(year) %>% 
      summarise(n=sum(n)) 
  }
  return(name_years)
}

# Testez votre fonction:
f_name_years("Lise",1980,1985,par_departement=TRUE)

Utilisez votre fonction f_name_years() dans sa nouvelle mouture pour simplifier l’appli. Puis répondez à la question suivante:

4.4 Ordre d’exécution

On peut essayer de comprendre l’ordre d’exécution des codes de l’appli shiny en rajoutant des instructions print() dans les codes.

Pour tester vous pouvez utiliser l’appli suivante:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
    print("............... executing f_name_years")
    name_years=prenoms %>% 
        filter(name==prenom,
               year>=annee_min,
               year<=annee_max)
    if(!par_departement){ 
        name_years=name_years %>% 
            group_by(year) %>% 
            summarise(n=n(),.groups = 'drop')
    }
    return(name_years)
}

ui <- fluidPage(
    wellPanel(
        textInput(inputId="prenom",
                  label="Quel est ton prénom?",
                  value="Lise"),   
        sliderInput("minmax_year",
                    "années min et max",
                    min=1900,
                    max=2018,
                    value=c(1900,2018))
    ), #wellPanel
    fluidRow(
        column(width=4,
               dataTableOutput("table_name_years")
        ),#column
        column(width=8,
               tabsetPanel(
                   tabPanel("France",
                            plotOutput("plot_name_years")
                   ),#tabPanel
                   tabPanel("Par dép.",
                            plotOutput("plot_name_years_dep")
                   )#tabPanel
               )#tabsetPanel
        )#column
    )#fluidRow
)

server <- function(input, output) {
   
    output$table_name_years <- renderDataTable({
        print("in table_name_years")
        f_name_years(input$prenom,
                     input$minmax_year[1],
                     input$minmax_year[2]) 
    })
    output$plot_name_years <- renderPlot({
        print("in plot_name_years")
        name_years=f_name_years(input$prenom,
                                input$minmax_year[1],
                                input$minmax_year[2]) 
        ggplot(name_years,aes(x=year,y=n)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année"))
        
    })
    output$plot_name_years_dep <- renderPlot({
        print("in plot_name_years_dep")
        name_years_dep= f_name_years(input$prenom,
                                     input$minmax_year[1],
                                     input$minmax_year[2],
                                     par_departement=TRUE) 
        ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
            geom_line()+
            labs(title=paste("Occurences du prénom '",
                             input$prenom,
                             "' par année et par département"))
        
    })
}

shinyApp(ui = ui, server = server)

Quiz

4.5 Réactive

Eh oui! Ici le code de la fonction f_names_year() est exécuté à chaque fois qu’un des inputs change, et ce pour tous les outputs (donc deux fois pour chaque changement d’input ici). Dans le cas qui nous intéresse ici, le calcul effectué par la fonction n’est pas très long, mais imaginez qu’il prenne un peu de temps (quelques secondes, quelques dizaines de secondes…)… Cela semble un gaspillage de ressource que de calculer plusieurs fois la même chose…

Vous allez essayer de remédier à cela en définissant une réactive.

Partie 5: Style et customisation

5.1 Ajouter du html

La solution à l’exercice précédent est:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max)
  if(!par_departement){ 
    name_years=name_years %>% 
      group_by(year) %>% 
      summarise(n=n(),.groups = 'drop')
  }
  return(name_years)
}

ui <- fluidPage(
  wellPanel(
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),   
    sliderInput("minmax_year",
                "années min et max",
                min=1900,
                max=2018,
                value=c(1900,2018))
  ), #wellPanel
  fluidRow(
    column(width=4,
           dataTableOutput("table_name_years")
    ),#column
    column(width=8,
           tabsetPanel(
             tabPanel("France",
             plotOutput("plot_name_years")
           ),#tabPanel
           tabPanel("Par dép.",
                    plotOutput("plot_name_years_dep")
           )#tabPanel
    )#tabsetPanel
  )#column
)#fluidRow
)

server <- function(input, output) {
  
  r_name_years=reactive({
    print("calcul de name_years")
    f_name_years(input$prenom,
                 input$minmax_year[1],
                 input$minmax_year[2])
  })
  
  output$table_name_years <- renderDataTable({
    name_years=r_name_years()
  })
  output$plot_name_years <- renderPlot({
    name_years=r_name_years()
    ggplot(name_years,aes(x=year,y=n)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année"))
    
  })
  output$plot_name_years_dep <- renderPlot({
    name_years_dep= f_name_years(input$prenom,
                                 input$minmax_year[1],
                                 input$minmax_year[2],
                                 par_departement=TRUE) 
    ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année et par département"))
    
  })
}

shinyApp(ui = ui, server = server)

Essayez de matérialiser l’existence de deux parties dans l’appli (une qui contient les inputs et l’autre les outputs) en rajoutant des titres de niveau 3 “Infos” et “Résultats”.

5.2 Changer de style via css

La solution à l’exercice précédent est:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max)
  if(!par_departement){ 
    name_years=name_years %>% 
      group_by(year) %>% 
      summarise(n=n(),.groups = 'drop')
  }
  return(name_years)
}

ui <- fluidPage(
  wellPanel(
    h3("Infos"),
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),   
    sliderInput("minmax_year",
                "années min et max",
                min=1900,
                max=2018,
                value=c(1900,2018))
  ), #wellPanel
  h3("Résultats"),
  fluidRow(
    column(width=4,
           dataTableOutput("table_name_years")
    ),#column
    column(width=8,
           tabsetPanel(
             tabPanel("France"),
                      plotOutput("plot_name_years")
             ),#tabPanel
             tabPanel("Par dép.",
                      plotOutput("plot_name_years_dep")
             )#tabPanel
           )#tabsetPanel
    )#column
  )#fluidRow
)

server <- function(input, output) {
  
  r_name_years=reactive({
    print("calcul de name_years")
    f_name_years(input$prenom,
                 input$minmax_year[1],
                 input$minmax_year[2])
  })
  
  output$table_name_years <- renderDataTable({
    r_name_years()
  })
  output$plot_name_years <- renderPlot({
    name_years=r_name_years()
    ggplot(name_years,aes(x=year,y=n)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année"))
    
  })
  output$plot_name_years_dep <- renderPlot({
    name_years_dep= f_name_years(input$prenom,
                                 input$minmax_year[1],
                                 input$minmax_year[2],
                                 par_departement=TRUE) 
    ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année et par département"))
    
  })
}
shinyApp(ui = ui, server = server)

Vous pouvez tenter de modifier le style css, par exemple en utilisant un thème prédéfini (il y en a deux que j’ai déjà téléchargés dans le dossier www si vous voulez tester…). Essayez par exemple le thème bootstrap.min_dark.css.

5.3 Ajouter un logo

Voici la solution à l’exercice précédent:

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max)
  if(!par_departement){ 
    name_years=name_years %>% 
      group_by(year) %>% 
      summarise(n=n(),.groups = 'drop')
  }
  return(name_years)
}

ui <- fluidPage(
  tags$head(tags$link(rel="stylesheet",
                      type="text/css",
                      href="bootstrap.min_dark.css")),
  fluidRow(column(width=4,img(src="tendance_prenom.png")),
           column(width=8,
                  wellPanel(
                    h3("Infos"),
                    textInput(inputId="prenom",
                              label="Quel est ton prénom?",
                              value="Lise"),   
                    sliderInput("minmax_year",
                                "années min et max",
                                min=1900,
                                max=2018,
                                value=c(1900,2018))
                  ) #wellPanel
           ) #column
  ),#fluidRow
  h3("Résultats"),
  fluidRow(
    column(width=4,
           dataTableOutput("table_name_years")
    ),#column
    column(width=8,
           tabsetPanel(
             tabPanel("France",
                      plotOutput("plot_name_years")
             ),#tabPanel
             tabPanel("Par dép.",
                      plotOutput("plot_name_years_dep")
             )#tabPanel
           )#tabsetPanel
    )#column
  )#fluidRow
)

server <- function(input, output) {
  
  r_name_years=reactive({
    print("calcul de name_years")
    f_name_years(input$prenom,
                 input$minmax_year[1],
                 input$minmax_year[2])
  })
  
  output$table_name_years <- renderDataTable({
    r_name_years()
  })
  output$plot_name_years <- renderPlot({
    name_years=r_name_years()
    ggplot(name_years,aes(x=year,y=n)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année"))
    
  })
  output$plot_name_years_dep <- renderPlot({
    name_years_dep= f_name_years(input$prenom,
                                 input$minmax_year[1],
                                 input$minmax_year[2],
                                 par_departement=TRUE) 
    ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année et par département"))
    
  })
}

shinyApp(ui = ui, server = server)

Je vous ai créé un magnifique logo pour votre appli dans le sous-dossier www (fichier tendance_prenom.png).

(Notez que votre appli sera plus jolie avec le thème “minty” que le thème “dark” hein je vous aurai prévenus!).

Rajoutez ce logo quelque part dans l’appli pour un effet de toute beauté.

Répondez ensuite à cette question.

Si ça vous plaît vous pouvez aussi ajouter des logos pour d’autre parties de l’appli (par exemple les images francemetrop.png et francemetrop_dep.png pour les deux tabPanels.)…

Partie 6: Extras

Bravo vous avez fini les exercices! Si vous en voulez encore vous pouvez essayer de rajouter une carte !

6.1 Une carte dans l’appli

Vous pouvez utiliser par exemple le shapefile (chemin “data/dep/dep_metrop.shp”). Il vous fournit les polygones des départements de France métropolitaine, que vous pourrez croiser avec le jeu de données prenom.

Libre à vous d’explorer / tester / changer les inputs et le type de carte mais pour vous guider en cas de problème voici un exemple avec une carte produite via le package tmap… C’est largement perfectible hein c’est juste une base pour que vous puissiez vous amuser!!

library(shiny)
library(dplyr)
prenoms=readRDS("data/prenoms.RDS")
library(ggplot2)
library(tmap)


dep=sf::st_read("data/dep/dep_metrop.shp")

f_name_years=function(prenom,annee_min,annee_max,par_departement=FALSE){
  name_years=prenoms %>% 
    filter(name==prenom,
           year>=annee_min,
           year<=annee_max)
  if(!par_departement){ 
    name_years=name_years %>% 
      group_by(year) %>% 
      summarise(n=n(),.groups = 'drop')
  }
  return(name_years)
}

ui <- fluidPage(
  tags$head(tags$link(rel="stylesheet",
                      type="text/css",
                      href="bootstrap.min_minty.css")),
  fluidRow(column(width=4,img(src="tendance_prenom.png")),
           column(width=8,
  wellPanel(
    h3("Infos"),
    textInput(inputId="prenom",
              label="Quel est ton prénom?",
              value="Lise"),   
    sliderInput("minmax_year",
                "années min et max",
                min=1900,
                max=2018,
                value=c(1900,2018))
  ) #wellPanel
  ) #column
  ),#fluidRow
  h3("Résultats"),
  fluidRow(
    column(width=4,
           dataTableOutput("table_name_years")
    ),#column
    column(width=8,
           tabsetPanel(
             tabPanel("France",
                      plotOutput("plot_name_years")
             ),#tabPanel
             tabPanel("Par dép.",
                      plotOutput("plot_name_years_dep")
             ),#tabPanel
             tabPanel("Carte",
                      tmapOutput("map_name_1year")
             )#tabPanel
           )#tabsetPanel
    )#column
  )#fluidRow
)

server <- function(input, output) {
  
  output$table_name_years <- renderDataTable({
    f_name_years(input$prenom,
                 input$minmax_year[1],
                 input$minmax_year[2]) 
  })
  output$plot_name_years <- renderPlot({
    name_years=f_name_years(input$prenom,
                            input$minmax_year[1],
                            input$minmax_year[2]) 
    ggplot(name_years,aes(x=year,y=n)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année"))
    
  })
  output$plot_name_years_dep <- renderPlot({
    name_years_dep= f_name_years(input$prenom,
                                 input$minmax_year[1],
                                 input$minmax_year[2],
                                 par_departement=TRUE) 
    ggplot(name_years_dep,aes(x=year,y=n, color=dpt)) +
      geom_line()+
      labs(title=paste("Occurences du prénom '",
                       input$prenom,
                       "' par année et par département"))
    
  })
  
  output$map_name_1year <- renderTmap({
    prenplot=prenoms %>% filter(name==input$prenom,year==2018)
    depplot=dep %>%   
      left_join(prenplot,by="dpt")
    
    tmap_mode("view")
    tm_shape(depplot)+
      tm_polygons(col="prop")})
}

shinyApp(ui = ui, server = server)