Optimisations

app.R

@@ -80,146 +80,128 @@ server <- function(input, output, session)
       setView(lat = 48.35, lng = 6, zoom = 8)
   })
 
+# in GHM
+  in_ghm <- reactive({
+    if (is.null(input$choice_ghm))
+      GHM
+    else
+      GHM %>% filter(GHM %in% input$choice_ghm)
+  })
+
+# in time
+  in_time <- reactive({
+    req(input$slider_date, in_ghm())
+
+    filter(in_ghm(), date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1])
+  })
+
   # in bounds
   in_bounds <- reactive({
-    req(input$map_bounds)
+    req(input$map_bounds, in_time())
 
     bounds <- input$map_bounds
     latrng <- range(bounds$north, bounds$south)
     lngrng <- range(bounds$east, bounds$west)
-    communes[lats >= latrng[1] & lats <= latrng[2] & lngs >= lngrng[1] & lngs <= lngrng[2],]$Codepos
+
+    codes_pos <- communes[lats >= latrng[1] & lats <= latrng[2] & lngs >= lngrng[1] & lngs <= lngrng[2],]$Codepos
+
+    filter(in_time(), Codepos %in% codes_pos)
   })
 
   # GHM
   data_ghm <- reactive({
-    req(input$slider_age, input$check_sexe, input$slider_date, in_bounds())
+    req(input$slider_age, input$check_sexe, input$slider_date, in_time())
 
-    GHM %>%
-      filter(Age <= input$slider_age[2] & Age >= input$slider_age[1], 
-             date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1],
-             Codepos %in% in_bounds(),
-             Sexe %in% input$check_sexe)
+      in_bounds() %>%
+        filter(Age <= input$slider_age[2] & Age >= input$slider_age[1], 
+               Sexe %in% input$check_sexe)
   })
 
   output$plot_ghm <- renderPlot({
-    data_ghm() %>%
-      count(GHM, Sexe) %>%
-      semi_join(GHM %>% count(GHM) %>% top_n(10) %>% arrange(n), by = "GHM") %>%
-      ungroup() %>%
-      mutate(GHM = GHM %>% factor(levels = GHM %>% unique)) %>%
-      ggplot() +
-      aes(x = GHM, y = n, fill = Sexe) +
-      geom_bar(stat = "identity") +
-      scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
-      coord_flip() +
-      theme(axis.title = element_blank(),
-            legend.position = "none")
+      data_ghm() %>%
+        count(GHM, Sexe) %>%
+        arrange(desc(n)) %>%
+        .[1:20,] %>%
+        ungroup() %>%
+        mutate(GHM = GHM %>% factor(levels = GHM %>% unique %>% rev)) %>%
+        ggplot() +
+        aes(x = GHM, y = n, fill = Sexe) +
+        geom_bar(stat = "identity") +
+        scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
+        coord_flip() +
+        theme(axis.title = element_blank(),
+              legend.position = "none")
   })
 
   # Sexe
   data_sexe <- reactive({
-    req(input$slider_age, input$slider_date, in_bounds())
+    req(input$slider_age, input$slider_date, in_time())
 
-    if (input$choice_ghm %>% is.null)
-    {
-      GHM %>%
-        filter(Age <= input$slider_age[2] & Age >= input$slider_age[1], 
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1],
-               Codepos %in% in_bounds())
-    } else
-    {
-      GHM %>%
-        filter(Age <= input$slider_age[2] & Age >= input$slider_age[1], 
-               GHM %in% input$choice_ghm,
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1],
-               Codepos %in% in_bounds())
-    }
+      in_bounds() %>%
+        filter(Age <= input$slider_age[2] & Age >= input$slider_age[1])
   })
 
   output$plot_sexe <- renderPlot({
-    data_sexe() %>%
-      ggplot() +
-      aes(x = 1, fill = Sexe) +
-      geom_bar() +
-      coord_flip() +
-      scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
-      theme(axis.title = element_blank(),
-            legend.position = "none",
-            axis.text.y = element_blank(),
-            axis.ticks.y = element_blank())
+      data_sexe() %>%
+        ggplot() +
+        aes(x = 1, fill = Sexe) +
+        geom_bar() +
+        coord_flip() +
+        scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
+        theme(axis.title = element_blank(),
+              legend.position = "none",
+              axis.text.y = element_blank(),
+              axis.ticks.y = element_blank())
   })
 
   # Age
   data_age <- reactive({
-    req(input$slider_date, input$check_sexe, in_bounds())
-
-    if (input$choice_ghm %>% is.null)
-    {
-      GHM %>%
-        filter(Sexe %in% input$check_sexe,
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1],
-               Codepos %in% in_bounds())  
-    } else
-    {
-      GHM %>%
-        filter(Sexe %in% input$check_sexe,
-               GHM %in% input$choice_ghm,
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1],
-               Codepos %in% in_bounds())
-    }
+    req(input$slider_date, input$check_sexe, in_time())
+
+      in_bounds() %>%
+        filter(Sexe %in% input$check_sexe)
   })
+
   output$plot_age <- renderPlot({ 
-    data_age() %>%
-      ggplot() +
-      aes(x = Age, fill = Sexe) +
-      geom_histogram(binwidth = 5) +
-      scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
-      scale_x_continuous(limits = c(min_age, max_age)) +
-      theme(axis.title = element_blank(),
-            legend.position = "none")
+      data_age() %>%
+        ggplot() +
+        aes(x = Age, fill = Sexe) +
+        geom_histogram(binwidth = 5) +
+        scale_fill_manual(values = c("Homme" = "lightblue", "Femme" = "pink")) +
+        scale_x_continuous(limits = c(min_age, max_age)) +
+        theme(axis.title = element_blank(),
+              legend.position = "none")
   })
 
   # filtered GHM
   filteredData <- reactive({
-    req(input$check_sexe, input$slider_age, input$slider_date) #, in_bounds())
-
-    if(input$choice_ghm %>% is.null)
-    {
-      GHM %>%
-        filter(Sexe %in% input$check_sexe,
-               Age <= input$slider_age[2] & Age >= input$slider_age[1],
-               # Codepos %in% in_bounds(),
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1]) %>%
-      count(Codepos)
-    } else
-    {
-      GHM %>%
-        filter(Sexe %in% input$check_sexe,
-               Age <= input$slider_age[2] & Age >= input$slider_age[1],
-               GHM %in% input$choice_ghm,
-               # Codepos %in% in_bounds(),
-               date_entree <= input$slider_date[2] & date_sortie >= input$slider_date[1]) %>%
-      count(Codepos)
-    }
+    req(input$check_sexe, input$slider_age, input$slider_date, in_time())
+
+    in_time() %>%
+      filter(Sexe %in% input$check_sexe,
+             Age <= input$slider_age[2] & Age >= input$slider_age[1]) %>%
+    count(Codepos)
   })
 
   # Map
   observe({
     req(filteredData())
 
-    comm <- communes
-    comm@data %>%
-      left_join(filteredData()) -> comm@data
+      comm <- communes
+      comm@data %>%
+        left_join(filteredData()) -> comm@data
+
+      comm <- comm[!is.na(comm$n),]
 
-   comm <- comm[!is.na(comm$n),]
+      pal <- colorNumeric(palette = topo.colors(100), domain = comm$n, na.color = NA, reverse = T)
 
-   pal <- colorNumeric(palette = topo.colors(100), domain = comm$n, na.color = NA, reverse = T)
+      leafletProxy("map") %>%
+        clearShapes() %>%
+        clearControls()
 
-    leafletProxy("map", data = comm) %>%
-      clearShapes() %>%
-      clearControls() %>%
-      addPolygons(weight = 1, color = "#222222", opacity = .1, fillOpacity = .3, fillColor = ~pal(n)) %>%
-      addLegend(position = "topleft", pal = pal, values = ~n)
+      leafletProxy("map", data = comm) %>%
+        addPolygons(weight = 1, color = "#222222", opacity = .1, fillOpacity = .3, fillColor = ~pal(n)) %>%
+        addLegend(position = "topleft", pal = pal, values = ~n)
   })
 }