3.1- Base de la réactivité: les expressions reactives

Pour rappel, voici comment l’on procède pour fournir un output réactif. On utilise les input, output et fonctions render**() :

3.2- Cheminement de la réactivité

ui=shinyUI(
  fluidPage(
    # App title ----
    titlePanel("Tabsets"),
    # Sidebar layout with input and output definitions ----
    sidebarLayout(
      # Sidebar panel for inputs ----
      sidebarPanel(
        radioButtons("a","Word 1:", c("Hello","Greetings")),
        radioButtons("b","Word 2:", c("benevolent","great")),
        radioButtons("c","Word 3:", c("Master","Human"))
        ),
      # Main panel for displaying outputs ----
      mainPanel(
        tabsetPanel(type = "tabs",
          tabPanel("tab1",textOutput("d")),
          tabPanel("tab2",textOutput("e")),
          selected="tab2")
        )
    )
)
)

server=shinyServer(function(input, output) {
  output$d <- renderText({Sys.sleep(1);paste(input$a,"!")})
  output$e <- renderText({Sys.sleep(1);paste(input$a,",",input$b,input$c,"!")})
})

shinyApp(ui=ui,server=server) 

Par la suite, l’output qui est attentif est actualisé à chaque fois qu’un de ses inputs (ici par exemple input_b) est modifié…

3.3- Modulariser les réactions

Exercice

Dans le code suivant, completez la fonction server et utilisez une expression reactive pour remplacer:

head(cars, input$nrows)

library(shiny)

ui <- fluidPage(
  h1("Example app"),
  sidebarLayout(
    sidebarPanel(
      numericInput("nrows", "Number of rows", 10)
    ),
    mainPanel(
      plotOutput("plot"),
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  # Assignment: Factor out the head(cars, input$nrows) so
  # that the code isn't duplicated and the operation isn't
  # performed twice for each change to input$nrows.
  
  output$plot <- renderPlot({
    plot(head(cars, input$nrows))
  })
  
  output$table <- renderTable({
    head(cars, input$nrows)
  })
}

shinyApp(ui, server)

3.4- Provoquer/retarder l’exécution: utilisation des triggers

Dans le mécanisme de réactivité le plus classique, un code est exécuté quand il correspond à un output “attentif” et que l’un de ses inputs est modifié.

Il est possible de contourner ce mécanisme et de faire en sorte que l’exécution d’un code soit déclenché par l’utilisateur.

Ce genre de mécanisme va de pair avec l’utilisation des widgets de type “trigger”:

3.4.1- Déclencher/provoquer l’exécution d’un code

  shinyApp(
    ui = basicPage( actionButton("go", "Go"),
                    textOutput("Sortie")),
    server = function(input, output, session) {
      observeEvent(input$go, {
        print(paste("This will only be printed once; all",
              "subsequent button clicks won't do anything")
              )
        output$Sortie<-renderText(paste("This will only be printed once; all",
              "subsequent button clicks won't do anything"))
      }, once = TRUE)
    }
  )

Exercice

Dans le code suivant, completez la fonction server. Il faut qu’en cliquant sur le bouton “save”, on enregistre les données au format csv dans le répertoire courant.

library(shiny)

ui <- fluidPage(
  h1("Example app"),
  sidebarLayout(
    sidebarPanel(
      numericInput("nrows", "Number of rows", 10),
      actionButton("save", "Save")
    ),
    mainPanel(
      plotOutput("plot"),
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  df <- reactive({
    head(cars, input$nrows)
  })
  
  output$plot <- renderPlot({
    plot(df())
  })
  
  output$table <- renderTable({
    df()
  })
  
  # Assignment: Add logic so that when the "save" button
  # is pressed, the data is saved to a CSV file called
  # "data.csv" in the current directory.
}

shinyApp(ui, server)

3.4.2- Déclencher/retarder une réaction

3.5- Empêcher des réactions

shinyApp(
  ui <- pageWithSidebar(
    headerPanel("Click the button"),
    sidebarPanel(
      sliderInput("obs", "Number of observations:",
                  min = 0, max = 1000, value = 500),
      actionButton("goButton", "Go!")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  ),
  server <- function(input, output) {
    output$distPlot <- renderPlot({
      
      # Take a dependency on input$goButton
      input$goButton
      
      # Use isolate() to avoid dependency on input$obs
      dist <- isolate(rnorm(input$obs))
      hist(dist)
    })
  }
)

Exercice

1. Tester et commenter le code suivant
2. Que pouvez-vous dire de onSessionStartet onSessionEnded?

library(shiny)

users = reactiveValues(count = 0)

ui = fluidPage(uiOutput("text"))

server = function(input, output, session) {
  onSessionStart = isolate({
    users$count = users$count + 1
  })
  
  onSessionEnded(function() {
    isolate({
      users$count = users$count - 1
    })
  })
  
  output$text = renderUI({
    h1(paste0("There are ", users$count, " user(s) connected to this app"))
  })
}

shinyApp(ui, server)

Un autre exemple interessant de l’utilisation des fonctions reactives est disponible ici:
https://shiny.rstudio.com/gallery/chat-room.html

3. Téléchargez et commentez l’application disponible ici: https://github.com/aoles/shinypass. Elle est également disponible dans le dossier “2 - Cas pratique/shinypass-master”

Cas Pratique

1. Dans notre application, certains calculs sont redondants. Utilisez les fonctions récatives de votre choix pour améliorer la performance du code.
2. Insérez un compteur d’utilisateurs (cf. exercice précedent) dans l’application.
3. Pour le moment, seules les parcelles de la ville de Montpellier sont analysées. Nous allons proposer à l’utilisateur de choisir la ville qu’il souhaite analyser. Plusieurs étapes sont ici nécessaires:
   • Etape 1: Créez une zone de sélection des communes via des listes déroulantes. Une pour le département qui permet de filtrer et de proposer une liste de communes correspondant au département sélectionné:

Vous pourrez ici vous servir des données commune_fr.rds et dep_fr.rds.

Le remplissage de la liste déroulante des communes se met à jour quand le département change. Vous pouvez le faire en utilisant côté serveur les fonctions observeEvent et updateSelectInput() * Etape 2: Il faut ensuite extraire les données de la commune attendue. Le code suivant permet d’extraire les données d’OpenStreetMap pour une commune donnée. Adaptez le à l’application:

library(sf)
library(tidyverse)

landuse <- read_csv2("Elements/data/landuse.csv")
commune_fr<-readRDS(file="Elements/data/commune_fr.rds")

library(osmdata)

bbox_select<-commune_fr%>%
  filter(NOM_COM=="MONTPELLIER")%>%
  st_bbox()%>%as.vector()

q0 <- opq(bbox =bbox_select) 

landuse_extract_bbox <- lapply(1:nrow(landuse),function(x){
  print(landuse$Valeur[x])
  q1 <- add_osm_feature(opq = q0, key = 'landuse', value = landuse$Valeur[x])
  res1 <- osmdata_sf(q1)
  if(!is.null(res1$osm_polygons)){
    poly <- res1$osm_polygons%>%
      select(geometry)%>%
      mutate(usage=landuse$Valeur[x])
  }
  if(!is.null(res1$osm_multipolygons)){
    multipoly <- res1$osm_multipolygons%>%
      select(geometry)%>%
      mutate(usage=landuse$Valeur[x])
  }
  if(!is.null(res1$osm_polygons) & !is.null(res1$osm_multipolygons)){
    poly%>%
      rbind(multipoly)
  }else if(!is.null(res1$osm_polygons)){
    poly
  }else if(!is.null(res1$osm_multipolygons)){
    multipoly
  }else{
    NULL
  }
})%>%
  do.call("rbind",.)

landuse_extract_bbox <- landuse_extract_bbox%>%
  mutate(superficie=st_area(geometry))

landuse_extract_bbox <- lwgeom::st_make_valid(landuse_extract_bbox)

landuse_extract_com <- landuse_extract_bbox%>%
  st_intersection(commune_fr%>%
            filter(NOM_COM=="MONTPELLIER")%>%
              select(geometry))

* **Etape 3:** L'exécution de l'extraction des données OSM est chronophage. Vous pouvez utiliser le package waiter pour forcer l'utilisateur à patienter: <https://github.com/JohnCoene/waiter>

Ressources

• Scoping rules for Shiny apps
• Vaudor, Lise. 2018. “Tutoriel Shiny Partie 4: Réactivité” R-atique: Analyse de Données Avec R
• Principles of Reactivity¨- Joe Cheng
• Waiter