|
@@ -80,146 +80,128 @@ server <- function(input, output, session) |
|
|
setView(lat = 48.35, lng = 6, zoom = 8) |
|
|
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 |
|
|
in_bounds <- reactive({ |
|
|
in_bounds <- reactive({ |
|
|
req(input$map_bounds) |
|
|
|
|
|
|
|
|
req(input$map_bounds, in_time()) |
|
|
|
|
|
|
|
|
bounds <- input$map_bounds |
|
|
bounds <- input$map_bounds |
|
|
latrng <- range(bounds$north, bounds$south) |
|
|
latrng <- range(bounds$north, bounds$south) |
|
|
lngrng <- range(bounds$east, bounds$west) |
|
|
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 |
|
|
# GHM |
|
|
data_ghm <- reactive({ |
|
|
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({ |
|
|
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 |
|
|
# Sexe |
|
|
data_sexe <- reactive({ |
|
|
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({ |
|
|
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 |
|
|
# Age |
|
|
data_age <- reactive({ |
|
|
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({ |
|
|
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 |
|
|
# filtered GHM |
|
|
filteredData <- reactive({ |
|
|
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 |
|
|
# Map |
|
|
observe({ |
|
|
observe({ |
|
|
req(filteredData()) |
|
|
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) |
|
|
}) |
|
|
}) |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|