UI revamp + nouveau plot Etudiant + séparation UI/Server/App

UI.R

@@ -0,0 +1,24 @@
+ui <- shinyUI(fluidPage(
+                        navbarPage("Celine 2.0", collapsible = T, id = "nav",
+                                   tabPanel("Accueil",
+                                            radioButtons("CESP", "Procédure", choices = c("Normale", "CESP"), selected = "Normale", inline = T),
+                                            uiOutput("dates")
+                                   ),
+                                   tabPanel("Listing",
+                                            DT::dataTableOutput("tableListing")),
+                                   tabPanel("Par étudiant",
+                                            div(style="display:inline-block",numericInput("Etudiant", "Étudiant", 1, min = 1, max = max_rank)),
+                                            div(style="display:inline-block",checkboxInput("Rang", "Afficher le rang dans un choix", value = T)),
+                                            plotlyOutput("plotEtudiant"), 
+                                            DT::dataTableOutput("tableEtudiant")
+                                            ),
+                                   tabPanel("Par discipline et subdivision",
+                                            div(style="display:inline-block",selectInput("Ville", "Ville", choices = villes)),
+                                            div(style="display:inline-block",selectInput("Spe", "Spé", choices = spes)),
+                                            plotlyOutput("plotVilleSpe"),
+                                            DT::dataTableOutput("tableVilleSpe")
+                                            )
+                                   )
+                        )
+)
+

app.R

@@ -1,306 +1,5 @@
-library(tidyverse)
-library(shiny)
-library(DT)
-library(RSQLite)
-library(stringr)
-library(plotly)
-library(forcats)
-
-uniq <- function(df, ...)
-{
-  eval(substitute(alist(...))) %>%
-    map_chr(as.character) %>%
-    intersect(names(df)) %>%
-    map(~rle(df[[.x]] %>% c) %>%
-            .$lengths %>%
-            cumsum) %>%
-    reduce(union) %>%
-    sort -> columns
-
-
-df[columns,]
-}
-
-Sys.setlocale("LC_TIME", "fr_FR.UTF-8")
-
-dbConnect(SQLite(), "ecn.db") -> db
-
-# Index villes et spés ----
-db %>%
-  tbl("trajectoires") %>%
-  select(Discipline, Subdivision) %>%
-  distinct %>%
-  collect -> villespe
-
-villespe %>%
-  select(Subdivision) %>%
-  distinct %>%
-  filter(Subdivision != "") %>%
-  arrange(Subdivision) %>%
-  pull(Subdivision) -> villes
-
-villespe %>%
-  select(Discipline) %>%
-  distinct %>%
-  filter(!Discipline %>% str_detect("(car aucun vœu)|(malgré.*)|(pas de.*)")) %>%
-  arrange(Discipline) %>%
-  pull(Discipline) -> spes
-
-# Max rank ----
-db %>%
-  tbl("trajectoires") %>%
-  select(Etudiant) %>%
-  distinct %>%
-  collect %>%
-  pull(Etudiant) %>%
-  max ->
-max_rank
-
-db %>% dbDisconnect
-
-# UI ----
-ui <- shinyUI(fluidPage(
-                        titlePanel("Celine Stalker"),
-                        uiOutput("dates"),
-                        sidebarLayout(
-                                      sidebarPanel(radioButtons("CESP", "Procédure", choices = c("Normale", "CESP"), selected = "Normale", inline = T),
-                                                   radioButtons("Select", "Chercher par", choices = c("étudiant", "ville + spé"), selected = "étudiant"),
-                                                   selectInput("Ville", "Ville", choices = villes),
-                                                   selectInput("Spe", "Spé", choices = spes),
-                                                   numericInput("Etudiant", "Étudiant", 1, min = 1, max = max_rank),
-                                                   checkboxInput("Rang", "Afficher le rang dans un choix", value = T)
-                                                   ),
-                                      mainPanel(
-                                                textOutput("plotly"),
-                                                plotlyOutput("outPlot"), 
-                                                dataTableOutput("outTable")
-                                                )
-                                      )
-                        )
-)
-
-# Server ----
-server <- shinyServer(function(input, output, session)
-{
-  updateDb <- reactiveTimer(4 * 60 * 1000, session)
-
-  db <- reactive(
-  {
-    req(input$CESP)
-    updateDb()
-
-    db <- dbConnect(SQLite(), "ecn.db", on.exit(dbDisconnect(db), add = T))
-
-    if (input$CESP == "CESP")
-    {
-      db %>%
-        tbl("trajectoires") %>%
-        filter(CESP == "CESP") %>%
-        collect %>%
-        rename(Date = timestamp)
-    } else
-    {
-      db %>%
-        tbl("trajectoires") %>%
-        filter(CESP == "") %>%
-        collect %>%
-        rename(Date = timestamp)
-    }
-  })
-
-  output$dates <- renderUI(
-  {
-    req(db())
-
-    db() %>%
-      select(Date) %>%
-      distinct %>%
-      pull(Date) %>%
-      range %>%
-      map(~as.POSIXct(.x) %>%
-          format(format = "%A %d %B %Y %H:%M") %>%
-          str_to_title) -> epoch
-
-    list(p(str_c("Données à partir du ", epoch[1])),
-         p(str_c("Dernières données du ", epoch[2])))
-  })
-
-  listingEtudiant <- reactive(
-  {
-    req(input$Etudiant)
-
-    db() %>%
-      filter(Etudiant == input$Etudiant) %>%
-      arrange(Date) %>%
-      select(Date, Etat, `Vœu`, Subdivision, Discipline, Rang) %>%
-      collect
-  })
-
-  tableEtudiant <- reactive(
-  {
-    req(listingEtudiant())
-
-    if (!input$Rang)
-    {
-      listingEtudiant() %>%
-        select(-Rang) %>%
-        uniq(Discipline, Subdivision) -> lst
-    } else
-    {
-      listingEtudiant() -> lst
-    }
-
-    lst
-  })
-
-  plotEtudiant <- reactive(
-  {
-    req(listingEtudiant())
-
-    listingEtudiant() %>%
-      select(Subdivision, Discipline, Date, Vœu) %>%
-      uniq(Subdivision, Discipline)
-  })
-
-  listingVilleSpe <- reactive(
-  {
-    req(input$Ville, input$Spe)
-
-    db() %>%
-      filter(Subdivision == input$Ville,
-             Discipline == input$Spe)
-  })
-
-  tableVilleSpe <- reactive(
-  {
-    req(listingVilleSpe())
-
-    listingVilleSpe() %>%
-      select(Date, Etudiant, Rang) %>%
-      group_by(Etudiant) %>%
-      filter(Date == max(Date)) %>%
-      ungroup %>%
-      arrange(Date)
-  })
-
-  plotVilleSpe <- reactive(
-  {
-    req(listingVilleSpe())
-
-    listingVilleSpe()$Etudiant %>%
-      unique -> etudiants
-
-    db() %>%
-      filter(Etudiant %in% etudiants) %>%
-      mutate(Date = Date %>% 
-             as.POSIXct,
-           Etudiant = Etudiant %>% factor,
-           Rang = if(Rang %>% is.character) Rang %>% str_replace("(\\d+)(/\\d+)?", "\\1") %>% as.numeric else Rang) %>%
-      mutate(Rang = ifelse(Subdivision != input$Ville | Discipline != input$Spe, -1, Rang)) %>%
-      select(Date, Etudiant, Rang) %>%
-      uniq(Etudiant, Rang) %>%
-      complete(Etudiant, Date) %>%
-      by(.$Etudiant, function(df)
-         {
-           which(df$Rang %>% is.na & !lead(df$Rang) %>% is.na) -> chg
-           which(!df$Rang %>% is.na & lead(df$Rang) %>% is.na) -> chg2
-
-           df$Rang[setdiff(chg, 1)] <- df$Rang[chg2]
-           if (last(df$Rang) %>% is.na)
-             df$Rang[length(df$Rang)] <- na.omit(df$Rang)[length(na.omit(df$Rang))]
-
-           df %>%
-             filter(!Rang %>% is.na)
-         }) %>%
-      Reduce(f = bind_rows) %>%
-      select(Date, Etudiant, Rang) %>%
-      mutate(Rang = ifelse(Rang == -1, NA, Rang))
-  })
-
-  output$outPlot <- renderPlotly({
-
-    if (input$Select == "étudiant")
-      plotEtudiant() %>%
-        mutate_if(is.character, factor) %>%
-        mutate_if(is.factor, fct_inorder) %>%
-        mutate_if(is.factor, unclass) %>%
-        ggplot(aes(x = Subdivision, y = Discipline, color = Vœu)) +
-        geom_path() +
-        scale_x_continuous(breaks = plotEtudiant()$Subdivision %>% factor %>% fct_inorder %>% unclass %>% unique, 
-                           labels = plotEtudiant()$Subdivision %>% factor %>% fct_inorder %>% levels) +
-        scale_y_continuous(breaks = plotEtudiant()$Discipline %>% factor %>% fct_inorder %>% unclass %>% unique, 
-                           labels = plotEtudiant()$Discipline %>% factor %>% fct_inorder %>% levels)
-      else
-        plotVilleSpe() %>%
-          ggplot(aes(x = Date, y = Rang, color = Etudiant, key = Etudiant)) +
-          geom_line() +
-          geom_point(data = plotVilleSpe() %>%
-                     group_by(Etudiant) %>%
-                     filter(!Rang %>% is.na & (lag(Rang) %>% is.na | lead(Rang) %>% is.na))
-                     )
-  })
-
-  output$outTable <- renderDataTable(
-  {
-    req(tableEtudiant(), tableVilleSpe())
-
-    if (input$Select == "étudiant")
-      tableEtudiant()
-    else
-      tableVilleSpe()
-  },
-  options = list(paging = F, searching = F, info = F),
-  selection = "none",
-  rownames = F
-  )
-
-  observeEvent(input$outTable_cell_clicked,
-               {
-                 info = input$outTable_cell_clicked
-                 if (is.null(info$value)) return()
-
-                 if (input$Select == "étudiant")
-                 {
-                   valueVille <- tableEtudiant()$Subdivision[info$row]
-                   valueSpe <- tableEtudiant()$Discipline[info$row]
-                   valueEtudiant <- input$Etudiant
-                   valueSelect <- "ville + spé"
-                 } else
-                 {
-                   valueVille <- input$Ville
-                   valueSpe <- input$Spe
-                   valueEtudiant <- tableVilleSpe()$Etudiant[info$row]
-                   valueSelect <- "étudiant"
-                 }
-
-                 updateNumericInput(session, "Etudiant", value = valueEtudiant)
-                 updateRadioButtons(session, "Ville", selected = valueVille)
-                 updateRadioButtons(session, "Spe", selected = valueSpe)
-                 updateRadioButtons(session, "Select", selected = valueSelect)
-               })
-
-  observeEvent(event_data("plotly_click"),
-               {
-                 info <- event_data("plotly_click")
-
-                 updateNumericInput(session, "Etudiant", value = info$key)
-                 updateRadioButtons(session, "Select", selected = "étudiant")
-               })
-
-  observeEvent(input$Etudiant,
-               {
-                 updateRadioButtons(session, "Select", selected = "étudiant")
-               })
-
-  observeEvent(input$Spe,
-               {
-                 updateRadioButtons(session, "Select", selected = "ville + spé")
-               })
-
-  observeEvent(input$Ville,
-               {
-                 updateRadioButtons(session, "Select", selected = "ville + spé")
-               })
-})
+source("misc.R")
+source("UI.R")
+source("server.R")
 
 shinyApp(ui, server, options = list(host = "0.0.0.0", port = 4377))

misc.R

@@ -0,0 +1,59 @@
+library(tidyverse)
+library(shiny)
+library(DT)
+library(RSQLite)
+library(stringr)
+library(plotly)
+library(forcats)
+
+uniq <- function(df, ...)
+{
+  eval(substitute(alist(...))) %>%
+    map_chr(as.character) %>%
+    intersect(names(df)) %>%
+    map(~rle(df[[.x]] %>% c) %>%
+            .$lengths %>%
+            cumsum) %>%
+    reduce(union) %>%
+    sort -> columns
+
+  df[columns,]
+}
+
+Sys.setlocale("LC_TIME", "fr_FR.UTF-8")
+
+dbConnect(SQLite(), "ecn.db") -> db
+
+# Index villes et spés ----
+db %>%
+  tbl("trajectoires") %>%
+  select(Discipline, Subdivision) %>%
+  distinct %>%
+  collect -> villespe
+
+villespe %>%
+  select(Subdivision) %>%
+  distinct %>%
+  filter(Subdivision != "") %>%
+  arrange(Subdivision) %>%
+  pull(Subdivision) -> villes
+
+villespe %>%
+  select(Discipline) %>%
+  distinct %>%
+  filter(!Discipline %>% str_detect("(car aucun vœu)|(malgré.*)|(pas de.*)")) %>%
+  arrange(Discipline) %>%
+  pull(Discipline) -> spes
+
+# Max rank ----
+db %>%
+  tbl("trajectoires") %>%
+  select(Etudiant) %>%
+  distinct %>%
+  collect %>%
+  pull(Etudiant) %>%
+  max ->
+max_rank
+
+db %>% dbDisconnect
+

server.R

@@ -0,0 +1,266 @@
+server <- shinyServer(function(input, output, session)
+{
+  updateDb <- reactiveTimer(4 * 60 * 1000, session)
+
+  db <- reactive(
+  {
+    req(input$CESP)
+    updateDb()
+
+    db <- dbConnect(SQLite(), "ecn.db", on.exit(dbDisconnect(db), add = T))
+
+    if (input$CESP == "CESP")
+    {
+      db %>%
+        tbl("trajectoires") %>%
+        filter(CESP == "CESP") %>%
+        collect %>%
+        rename(Date = timestamp)
+    } else
+    {
+      db %>%
+        tbl("trajectoires") %>%
+        filter(CESP == "") %>%
+        collect %>%
+        rename(Date = timestamp)
+    }
+  })
+
+  output$dates <- renderUI(
+  {
+    req(db())
+
+    db() %>%
+      select(Date) %>%
+      distinct %>%
+      pull(Date) %>%
+      range %>%
+      map(~as.POSIXct(.x) %>%
+          format(format = "%A %d %B %Y %H:%M") %>%
+          str_to_title) -> epoch
+
+    list(p(str_c("Données à partir du ", epoch[1])),
+         p(str_c("Dernières données du ", epoch[2])))
+  })
+
+# Listing ----
+  listing <- reactive(
+  {
+    db() %>%
+      group_by(Etudiant) %>%
+      filter(Date == max(Date)) %>%
+      ungroup %>%
+      mutate(Etudiant = Etudiant %>% as.numeric,
+             Subdivision = Subdivision %>% as.factor,
+             Discipline = Discipline %>% as.factor) %>%
+      arrange(Etudiant) %>%
+      select(Etudiant, Etat, Absence, `Vœu`, Subdivision, Discipline, Rang, Date)
+  })
+
+  output$tableListing <- DT::renderDataTable(
+  {
+    listing()
+  },
+  options = list(paging = F, info = F),
+  selection = "none",
+  rownames = F,
+  filter = "top"
+)
+
+# Etudiant ----
+  listingEtudiant <- reactive(
+  {
+    req(input$Etudiant)
+
+    db() %>%
+      filter(Etudiant == input$Etudiant) %>%
+      arrange(Date) %>%
+      select(Etudiant, Date, Etat, `Vœu`, Subdivision, Discipline, Rang) %>%
+      collect
+  })
+
+  tableEtudiant <- reactive(
+  {
+    req(listingEtudiant())
+
+    if (!input$Rang)
+    {
+      listingEtudiant() %>%
+        select(-Rang, -Etudiant) %>%
+        uniq(Discipline, Subdivision) -> lst
+    } else
+    {
+      listingEtudiant() -> lst
+    }
+
+    lst
+  })
+
+  output$tableEtudiant <- DT::renderDataTable(
+  {
+    req(tableEtudiant())
+
+    tableEtudiant()
+  },
+  options = list(paging = F, searching = F, info = F),
+  selection = "none",
+  rownames = F
+  )
+
+  output$plotEtudiant <- renderPlotly(
+  {
+    req(listingEtudiant())
+
+    listingEtudiant() %>%
+      select(Etudiant, Subdivision, Discipline, Date, Vœu) %>%
+      uniq(Subdivision, Discipline) %>%
+      unite(Choix, Subdivision, Discipline, sep = " - ") %>%
+      mutate(Date = Date %>% as.POSIXct) %>%
+      arrange(Date) ->
+    plotEtudiant
+
+    plotEtudiant %>%
+      ggplot(aes(x = Date, y = Choix, group = Etudiant)) +
+      geom_step() +
+      geom_point() +
+      theme(axis.text.x = element_text(angle = -45, hjust = 0))
+  })
+
+# VilleSpe ----
+  listingVilleSpe <- reactive(
+  {
+    req(input$Ville, input$Spe)
+
+    db() %>%
+      filter(Subdivision == input$Ville,
+             Discipline == input$Spe) -> lst
+
+    if (nrow(lst) == 0)
+      NULL
+    else
+      lst
+  })
+
+  tableVilleSpe <- reactive (
+  {
+    req(listingVilleSpe())
+
+    listingVilleSpe() %>%
+      select(Date, Etudiant, Rang) %>%
+      group_by(Etudiant) %>%
+      filter(Date == max(Date)) %>%
+      ungroup %>%
+      arrange(Date)
+  })
+
+  output$tableVilleSpe <- DT::renderDataTable(
+  {
+    req(tableVilleSpe())
+
+    tableVilleSpe()
+  },
+  options = list(paging = F, searching = F, info = F),
+  selection = "none",
+  rownames = F
+  )
+
+  output$plotVilleSpe <- renderPlotly(
+  {
+    req(listingVilleSpe())
+
+    listingVilleSpe()$Etudiant %>%
+      unique -> etudiants
+
+    db() %>%
+      filter(Etudiant %in% etudiants) %>%
+      mutate(Date = Date %>% 
+             as.POSIXct,
+           Etudiant = Etudiant %>% factor,
+           Rang = if(Rang %>% is.character) Rang %>% str_replace("(\\d+)(/\\d+)?", "\\1") %>% as.numeric else Rang) %>%
+      mutate(Rang = ifelse(Subdivision != input$Ville | Discipline != input$Spe, -1, Rang)) %>%
+      select(Date, Etudiant, Rang) %>%
+      uniq(Etudiant, Rang) %>%
+      complete(Etudiant, Date) %>%
+      by(.$Etudiant, function(df)
+         {
+           which(df$Rang %>% is.na & !lead(df$Rang) %>% is.na) -> chg
+           which(!df$Rang %>% is.na & lead(df$Rang) %>% is.na) -> chg2
+
+           df$Rang[setdiff(chg, 1)] <- df$Rang[chg2]
+           if (last(df$Rang) %>% is.na)
+             df$Rang[length(df$Rang)] <- na.omit(df$Rang)[length(na.omit(df$Rang))]
+
+           df %>%
+             filter(!Rang %>% is.na)
+         }) %>%
+      Reduce(f = bind_rows) %>%
+      select(Date, Etudiant, Rang) %>%
+      mutate(Rang = ifelse(Rang == -1, NA, Rang)) ->
+    plotVilleSpe
+
+    plotVilleSpe %>%
+      ggplot(aes(x = Date, y = Rang, color = Etudiant, key = Etudiant)) +
+      geom_line() +
+      geom_point(data = plotVilleSpe %>%
+                 group_by(Etudiant) %>%
+                 filter(!Rang %>% is.na & (lag(Rang) %>% is.na | lead(Rang) %>% is.na))) +
+                 scale_y_continuous(trans = "reverse", breaks = unique(plotVilleSpe$Rang))
+  })
+
+# Interactivity ----
+  observeEvent(input$tableListing_cell_clicked,
+               {
+                 info = input$tableListing_cell_clicked
+                 if (is.null(info$value)) return()
+
+                 if (info$col == 0)
+                 {
+                   updateNumericInput(session, "Etudiant", value =  listing()$Etudiant[info$row])
+                   updateTabsetPanel(session, "nav", selected = "Par étudiant")
+                 } else if (info$col %in% 4:5)
+                 {
+                   updateSelectInput(session, "Ville", selected =  listing()$Subdivision[info$row])
+                   updateSelectInput(session, "Spe", selected =  listing()$Discipline[info$row])
+                   updateTabsetPanel(session, "nav", selected = "Par discipline et subdivision")
+                 }
+               })
+
+  observeEvent(input$tableEtudiant_cell_clicked,
+               {
+                 info = input$tableEtudiant_cell_clicked
+                 if (is.null(info$value)) return()
+
+                 updateSelectInput(session, "Ville", selected =  tableEtudiant()$Subdivision[info$row])
+                 updateSelectInput(session, "Spe", selected =  tableEtudiant()$Discipline[info$row])
+                 updateTabsetPanel(session, "nav", selected = "Par discipline et subdivision")
+               })
+
+  observeEvent(input$tableVilleSpe_cell_clicked,
+               {
+                 info = input$tableVilleSpe_cell_clicked
+                 if (is.null(info$value)) return()
+
+                 updateNumericInput(session, "Etudiant", value =  tableVilleSpe()$Etudiant[info$row])
+                 updateTabsetPanel(session, "nav", selected = "Par étudiant")
+               })
+
+  observeEvent(event_data("plotly_click"),
+               {
+                 info <- event_data("plotly_click")
+
+                 if (!info$key %>% is.null)
+                 {
+                   updateNumericInput(session, "Etudiant", value = info$key)
+                   updateTabsetPanel(session, "nav", selected = "Par étudiant")
+                 } else
+                 {
+                   print(info$y)
+                   info$y %>% str_replace("(.*?) - .*", "\\1") -> ville
+                   info$y %>% str_replace(".*? - (.*)", "\\1") -> spe
+
+                   updateSelectInput(session, "Ville", selected =  ville)
+                   updateSelectInput(session, "Spe", selected =  spe)
+                   updateTabsetPanel(session, "nav", selected = "Par discipline et subdivision")
+                 }
+               })
+})