|
|
@@ -80,7 +80,7 @@ server <- function(input, output, session) |
|
|
|
setView(lat = 48.35, lng = 6, zoom = 8) |
|
|
|
}) |
|
|
|
|
|
|
|
# in GHM |
|
|
|
# in GHM |
|
|
|
in_ghm <- reactive({ |
|
|
|
if (is.null(input$choice_ghm)) |
|
|
|
GHM |
|
|
@@ -88,7 +88,7 @@ server <- function(input, output, session) |
|
|
|
GHM %>% filter(GHM %in% input$choice_ghm) |
|
|
|
}) |
|
|
|
|
|
|
|
# in time |
|
|
|
# in time |
|
|
|
in_time <- reactive({ |
|
|
|
req(input$slider_date, in_ghm()) |
|
|
|
|
|
|
@@ -112,65 +112,65 @@ server <- function(input, output, session) |
|
|
|
data_ghm <- reactive({ |
|
|
|
req(input$slider_age, input$check_sexe, input$slider_date, in_time()) |
|
|
|
|
|
|
|
in_bounds() %>% |
|
|
|
filter(Age <= input$slider_age[2] & Age >= input$slider_age[1], |
|
|
|
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) %>% |
|
|
|
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") |
|
|
|
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_time()) |
|
|
|
|
|
|
|
in_bounds() %>% |
|
|
|
filter(Age <= input$slider_age[2] & Age >= input$slider_age[1]) |
|
|
|
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_time()) |
|
|
|
|
|
|
|
in_bounds() %>% |
|
|
|
filter(Sexe %in% input$check_sexe) |
|
|
|
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 |
|
|
@@ -187,22 +187,23 @@ server <- function(input, output, session) |
|
|
|
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") %>% |
|
|
|
clearShapes() %>% |
|
|
|
clearControls() |
|
|
|
|
|
|
|
leafletProxy("map", data = comm) %>% |
|
|
|
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) |
|
|
|
}) |
|
|
|
} |
|
|
|
|
|
|
|
# App ---- |
|
|
|
shinyApp(ui = ui, server = server) |