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()$Date %>% range %>% map(~as.POSIXct(.x) %>% format(format = "%A %d %B %Y %H:%M") %>% str_to_title) -> epoch list(p(str_c("Données enregistrées du ", epoch[1], " au ", 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, Etat = Etat %>% 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, first = T) -> lst } else { listingEtudiant() -> lst } lst }) output$tableEtudiant <- DT::renderDataTable( { req(tableEtudiant()) tableEtudiant() }, options = list(paging = F, searching = F, info = F), selection = "none", rownames = F ) plotEtudiant <- reactive( { req(listingEtudiant()) db()$Date %>% max -> epoch listingEtudiant() %>% select(Etudiant, Subdivision, Discipline, Date, Vœu) %>% uniq(Subdivision, Discipline, first = T) %>% add_row(Date = epoch, Etudiant = last(.$Etudiant), Subdivision = last(.$Subdivision), Discipline = last(.$Discipline)) %>% unite(Choix, Subdivision, Discipline, sep = " - ") %>% mutate(Choix = Choix %>% factor %>% fct_inorder) %>% mutate(Date = Date %>% as.POSIXct) }) output$plotEtudiant <- renderPlotly( { req(plotEtudiant()) plotEtudiant() %>% ggplot(aes(x = Date, y = Choix, group = Etudiant)) + geom_step() + geom_point() + theme(axis.text.x = element_text(angle = -45, hjust = 0)) + scale_y_discrete(limits = plotEtudiant()$Choix %>% levels %>% rev) }) # VilleSpe ---- listingVilleSpe <- reactive( { req(input$Ville, input$Spe) db() %>% filter(Subdivision == input$Ville, Discipline == input$Spe) -> lst if (nrow(lst) == 0) { NULL } else { lst$Etudiant %>% unique -> etudiants db() %>% filter(Etudiant %in% etudiants) %>% mutate(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)) } }) tableVilleSpe <- reactive ( { req(listingVilleSpe()) listingVilleSpe() %>% select(Date, Etudiant, Rang) %>% group_by(Etudiant) %>% filter(!Rang %>% is.na) %>% 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() %>% mutate(Date = Date %>% as.POSIXct) %>% ggplot(aes(x = Date, y = Rang, color = Etudiant, key = Etudiant)) + geom_line() + geom_point(data = listingVilleSpe() %>% mutate(Date = Date %>% as.POSIXct) %>% group_by(Etudiant) %>% filter(!Rang %>% is.na & (lag(Rang) %>% is.na | lead(Rang) %>% is.na))) + scale_y_continuous(trans = "reverse", breaks = unique(listingVilleSpe()$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 { plotEtudiant()$Choix %>% factor %>% fct_inorder %>% levels %>% rev -> choix choix[info$y] %>% str_replace("(.*?) - .*", "\\1") -> ville choix[info$y] %>% str_replace(".*? - (.*)", "\\1") -> spe updateSelectInput(session, "Ville", selected = ville) updateSelectInput(session, "Spe", selected = spe) updateTabsetPanel(session, "nav", selected = "Par discipline et subdivision") } }) })