GeoGHM/app.R

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)