Initial versio

app.R

@@ -0,0 +1,118 @@
+library(tidyverse)
+library(shiny)
+library(leaflet)
+library(RColorBrewer)
+library(sp)
+library(rgdal)
+library(plotly)
+library(stringr)
+
+read.csv("ghm.csv") %>%
+  `names<-`(c("IPP", "IEP", "Age", "Sexe", "CP", "GHM", "date_entree", "date_sortie")) %>%
+  mutate(DS = as.numeric(date_sortie - date_entree),
+         Sexe = Sexe %>% factor(labels = c("Homme", "Femme"))) -> GHM
+
+read_csv2("insee.csv") %>%
+  select(Codepos, insee = INSEE) %>%
+# filter(Codepos %in% GHM$CP),
+  filter(Codepos %>% str_detect("^(54|57|55|88)")) %>%
+  mutate(insee = insee %>% as.character)-> insee
+
+readOGR("communes/") -> communes
+
+communes@data %>%
+  left_join(insee) -> communes@data
+
+communes <- communes[!is.na(communes$Codepos),]
+
+  lngs <- communes@polygons %>% map(~slot(.x, "labpt")) %>% map_dbl(1)
+  lats <- communes@polygons %>% map(~slot(.x, "labpt")) %>% map_dbl(2)
+
+  ui <- bootstrapPage(
+                      tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
+                      leafletOutput("map", width = "100%", height = "100%"),
+                      absolutePanel(top = 10, right = 10,
+                                    # GHM
+                                    # plotlyOutput("plot_ghm"),
+                                    # selectizeInput("choice_ghm", "GHM", GHM$GHM %>% factor %>% levels, multiple = T),
+                                    # Age
+                                    # plotlyOutput("plot_age"),
+                                    # sliderInput("slider_age", "Age", min(GHM$Age), max(GHM$Age), value = c(min(GHM$Age), max(GHM$Age))),
+                                    # Sexe
+                                    # plotlyOutput("plot_sexe"),
+                                    checkboxGroupInput("check_sexe", "Sexe", c("Homme", "Femme"), c("Homme", "Femme"))
+                                    ),
+                      absolutePanel(bottom = 10, left = "5%", width = "90%",
+                                    sliderInput("slider_date", "Dates", width = "100%", min = as.Date("2005-01-01"), max = as.Date("2017-01-01"), value = c(as.Date("2016-01-01"), as.Date("2017-01-01")), animate = animationOptions(interval = 0))
+                                    )
+                      )
+
+  server <- function(input, output, session)
+  {
+    # Create map
+    output$map <- renderLeaflet({
+      leaflet(communes, options = leafletOptions(minZoom = 7, maxZoom = 15)) %>%
+        addProviderTiles(providers$CartoDB.Positron) %>%
+        addPolygons(weight = 1, color = "#222222", opacity = .1, fillOpacity = .1, fillColor = "#EEEEEE") %>%
+        setView(lat = 48.35, lng = 6, zoom = 9)
+    })
+    # Filter in bounds
+    in_bounds <- reactive({
+      if (is.null(input$map_bounds))
+          return(communes[F,])
+      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],]
+    })
+    # Filter GHM
+    # filteredData <- reactive({
+    # GHM %>%
+    # filter(Sexe %in% input$check_sexe,
+    # 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],
+    # CP %in% in_bounds$insee)
+    # })
+    # Plots
+    # observe({
+    # output$plot_sexe <- renderPlotly({
+    # filteredData() %>%
+    # (
+    # ggplot() +
+    # aes(x = Sexe) +
+    # geom_bar(position = "stacked")
+    # ) %>% ggplotly
+    # })
+    # })
+    # observe({
+    # output$plot_age <- renderPlotly({
+    # filteredData() %>%
+    # (
+    # ggplot() +
+    # aes(x = Age, y = ..density..) +
+    # geom_histogram() +
+    # geom_density()
+    # ) %>% ggplotly
+    # })
+    # })
+    # observe({
+      # leafletProxy("map", data = in_bounds()) %>%
+        # clearShapes() %>%
+    # })
+    # Use a separate observer to recreate the legend as needed.
+    # observe({
+    # Remove any existing legend, and only if the legend is
+    # enabled, create a new one.
+    # leafletProxy("map", data = quakes) %>%
+    # clearControls()
+    # if (input$legend) {
+    # pal <- colorpal()
+    # proxy %>% addLegend(position = "bottomright",
+    # pal = pal, values = ~mag
+    # )
+    # }
+    # })
+  }
+
+shinyApp(ui = ui, server = server)