celine2.0/server_.R

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")
                 }
               })
})