From f4366abea31e664a34ca873ebf4b5db9354a3cbc Mon Sep 17 00:00:00 2001 From: Maxime Wack Date: Sun, 5 Mar 2017 23:50:28 +0100 Subject: [PATCH] Initial versio --- app.R | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 118 insertions(+) diff --git a/app.R b/app.R index e69de29..3dae1c0 100644 --- a/app.R +++ b/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)