From f0b80be5cdc2c7b00c733107136a938b0db2231e Mon Sep 17 00:00:00 2001
From: Vincent DUPONT <hello@vincentdupont.com>
Date: Mon, 13 Jan 2025 18:01:56 +0100
Subject: [PATCH] Update Maping for tri_f
---
modules/harmonized_loc.R | 313 +++++++++++++++++++++++----------------
modules/map.R | 292 ++++++++++++++----------------------
2 files changed, 301 insertions(+), 304 deletions(-)
diff --git a/modules/harmonized_loc.R b/modules/harmonized_loc.R
index 559a442..136749b 100644
--- a/modules/harmonized_loc.R
+++ b/modules/harmonized_loc.R
@@ -1,10 +1,9 @@
-### harmonized_loc.R - Analyse par localisation
+### Harmonized tab for Brazil/Colombia analysis
##################
-### Préparation des données de base
+### Data objects
##################
-# Fonctions réactives pour les dates
date1 <- reactive({
as.Date(paste0(input$HARLOCdates[1],"-01-01"))
})
@@ -13,148 +12,99 @@ date2 <- reactive({
as.Date(paste0(input$HARLOCdates[2],"-12-31"))
})
-# Préparation des listes de zones pour la Colombie
+# Colombia residential areas
HARLOC_residencial_area_co <- JSON_area_har %>%
filter(source == "CO") %>%
select(id, name) %>%
arrange(name)
+HARLOC_residencial_area_list_co <- with(HARLOC_residencial_area_co, split(id, name))
-# Création de la liste pour la sélection UI
-HARLOC_residencial_area_list_co <- setNames(
- as.list(HARLOC_residencial_area_co$id),
- HARLOC_residencial_area_co$name
-)
-
-# Préparation des listes pour le Brésil
+# Brazil residential areas
HARLOC_residencial_area_br <- JSON_area_har %>%
filter(source == "BR") %>%
select(id, name) %>%
arrange(name)
+HARLOC_residencial_area_list_br <- with(HARLOC_residencial_area_br, split(id, name))
-HARLOC_residencial_area_list_br <- setNames(
- as.list(HARLOC_residencial_area_br$id),
- HARLOC_residencial_area_br$name
-)
-
-print("Listes de sélection :")
-print("Colombie :")
-print(str(HARLOC_residencial_area_list_co))
-print("Brésil :")
-print(str(HARLOC_residencial_area_list_br))
-
-# Préparation des centres de santé
-# Pour la Colombie
+# Colombia health centers
HARLOC_health_center_co <- JSON_healthcenter_har %>%
filter(source == "CO") %>%
select(id_center, name) %>%
arrange(name)
+HARLOC_health_center_list_co <- with(HARLOC_health_center_co, split(id_center, name))
-HARLOC_health_center_list_co <- setNames(
- as.list(HARLOC_health_center_co$id_center),
- HARLOC_health_center_co$name
-)
-
-# Pour le Brésil
+# Brazil health centers
HARLOC_health_center_br <- JSON_healthcenter_har %>%
filter(source == "BR") %>%
select(id_center, name) %>%
arrange(name)
+HARLOC_health_center_list_br <- with(HARLOC_health_center_br, split(id_center, name))
-HARLOC_health_center_list_br <- setNames(
- as.list(HARLOC_health_center_br$id_center),
- HARLOC_health_center_br$name
-)
-
-##################
-### Interface utilisateur réactive
-##################
-
-# Interface pour la sélection des localités brésiliennes
-output$HARLOClocation_br <- renderUI({
+# UI Outputs for location selection
+output$HARLOClocation_co <- renderUI({
switch(input$HARLOCtype,
- "residence_area" = {
- choices <- HARLOC_residencial_area_list_br
- selectInput(
- "HARLOCselection_br",
- tr("BR"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- },
- "center" = {
- choices <- HARLOC_health_center_list_br
- selectInput(
- "HARLOCselection_br",
- tr("BR"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- },
- "infection_place" = {
- choices <- HARLOC_residencial_area_list_br
- selectInput(
- "HARLOCselection_br",
- tr("BR"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- }
+ "residence_area" = selectInput("HARLOCselection_co", tr("CO"), HARLOC_residencial_area_list_co, multiple = TRUE),
+ "center" = selectInput("HARLOCselection_co", tr("CO"), HARLOC_health_center_list_co, multiple = TRUE),
+ "infection_place" = selectInput("HARLOCselection_co", tr("CO"), HARLOC_residencial_area_list_co, multiple = TRUE)
)
})
-# Interface pour la sélection des localités colombiennes
-output$HARLOClocation_co <- renderUI({
+output$HARLOClocation_br <- renderUI({
switch(input$HARLOCtype,
- "residence_area" = {
- choices <- HARLOC_residencial_area_list_co
- selectInput(
- "HARLOCselection_co",
- tr("CO"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- },
- "center" = {
- choices <- HARLOC_health_center_list_co
- selectInput(
- "HARLOCselection_co",
- tr("CO"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- },
- "infection_place" = {
- choices <- HARLOC_residencial_area_list_co
- selectInput(
- "HARLOCselection_co",
- tr("CO"),
- choices = choices,
- multiple = TRUE,
- selectize = TRUE
- )
- }
+ "residence_area" = selectInput("HARLOCselection_br", tr("BR"), HARLOC_residencial_area_list_br, multiple = TRUE, selected = c("126")),
+ "center" = selectInput("HARLOCselection_br", tr("BR"), HARLOC_health_center_list_br, multiple = TRUE),
+ "infection_place" = selectInput("HARLOCselection_br", tr("BR"), HARLOC_residencial_area_list_br, multiple = TRUE)
)
})
-##################
-### Filtrage des données
-##################
-
-# Données pour la Colombie
+# Filter for Colombia data
HARLOC_sub_co <- reactive({
- req(input$HARLOCtype)
- req(input$HARLOCselection_co)
+ df <- consultation_har_filter(JSON_cons_har,
+ source = "CO",
+ new_attack = input$HARLOCnew_attack,
+ diagn = input$HARLOCdiagn,
+ sex = input$HARLOCsex,
+ minAge = input$HARLOCage[1],
+ maxAge = input$HARLOCage[2]
+ ) %>%
+ filter(consultation_date >= date1() & consultation_date <= date2())
+
+ if(input$HARLOCtype == "center"){
+ df <- df %>% filter(id_center %in% input$HARLOCselection_co)
+ } else if(input$HARLOCtype == "residence_area"){
+ df <- df %>% filter(residence_place %in% input$HARLOCselection_co)
+ } else if(input$HARLOCtype == "infection_place"){
+ df <- df %>% filter(infection_place %in% input$HARLOCselection_co)
+ }
+
+ return(df)
+})
+
+# Filter for Brazil data
+HARLOC_sub_br <- reactive({
+ df <- consultation_har_filter(JSON_cons_har,
+ source = "BR",
+ new_attack = input$HARLOCnew_attack,
+ diagn = input$HARLOCdiagn,
+ sex = input$HARLOCsex,
+ minAge = input$HARLOCage[1],
+ maxAge = input$HARLOCage[2]
+ ) %>%
+ filter(consultation_date >= date1() & consultation_date <= date2())
- # Ajout de messages de diagnostic
- print("Filtrage des données colombiennes")
- print(paste("Type sélectionné:", input$HARLOCtype))
- print(paste("Sélections:", paste(input$HARLOCselection_co, collapse=", ")))
+ if(input$HARLOCtype == "center"){
+ df <- df %>% filter(id_center %in% input$HARLOCselection_br)
+ } else if(input$HARLOCtype == "residence_area"){
+ df <- df %>% filter(residence_place %in% input$HARLOCselection_br)
+ } else if(input$HARLOCtype == "infection_place"){
+ df <- df %>% filter(infection_place %in% input$HARLOCselection_br)
+ }
+ return(df)
+})
+
+# Information quality filters
+HARLOC_sub_infqual_co <- reactive({
df <- consultation_har_filter(JSON_cons_har,
source = "CO",
new_attack = input$HARLOCnew_attack,
@@ -163,21 +113,132 @@ HARLOC_sub_co <- reactive({
minAge = input$HARLOCage[1],
maxAge = input$HARLOCage[2]
) %>%
- filter(consultation_date >= date1() &
- consultation_date <= date2())
+ filter(consultation_date >= date1() & consultation_date <= date2()) %>%
+ is.na() %>%
+ colMeans() * 100
- # Filtrage selon le type de localisation
- df <- switch(input$HARLOCtype,
- "center" = df %>% filter(id_center %in% input$HARLOCselection_co),
- "residence_area" = df %>% filter(residence_place %in% input$HARLOCselection_co),
- "infection_place" = df %>% filter(infection_place %in% input$HARLOCselection_co)
- )
+ df <- replace(df, is.nan(df), 100)
+ return(df)
+})
+
+HARLOC_sub_infqual_br <- reactive({
+ df <- consultation_har_filter(JSON_cons_har,
+ source = "BR",
+ new_attack = input$HARLOCnew_attack,
+ diagn = input$HARLOCdiagn,
+ sex = input$HARLOCsex,
+ minAge = input$HARLOCage[1],
+ maxAge = input$HARLOCage[2]
+ ) %>%
+ filter(consultation_date >= date1() & consultation_date <= date2()) %>%
+ is.na() %>%
+ colMeans() * 100
- print(paste("Nombre de cas après filtrage:", nrow(df)))
+ df <- replace(df, is.nan(df), 100)
return(df)
})
-# Données pour le Brésil (même structure)
-HARLOC_sub_br <- reactive({
- # Code similaire pour le Brésil
+# Day of week tabulation
+HARLOC_co_tab_day_week <- reactive({
+ if(nrow(HARLOC_sub_co()) > 0){
+ as.data.frame(incidence(HARLOC_sub_co()$consultation_date, interval = 1))
+ }
+})
+
+HARLOC_br_tab_day_week <- reactive({
+ if(nrow(HARLOC_sub_br()) > 0){
+ as.data.frame(incidence(HARLOC_sub_br()$consultation_date, interval = 1))
+ }
+})
+
+##################
+### Plots
+##################
+
+# Incidence plot
+output$HARLOC_plot_incidence <- renderPlotly({
+ # Variables
+ HARLOCtype <- input$HARLOCtype
+ HARLOCagg <- as.numeric(input$HARLOCagg)
+
+ # Main plot configuration
+ plot_incidence <- plot_ly() %>%
+ layout(xaxis = list(title = tr("date")), yaxis = list(title = tr("cases"))) %>%
+ layout(legend = list(x = 0, y = -.25, orientation = 'h'), showlegend=TRUE)
+
+ if(HARLOCtype == "center"){
+ if(HARLOCagg == 30){ # Monthly aggregation (example for one aggregation type)
+ # Colombia
+ for(loc in unique(HARLOC_sub_co()$id_center)){
+ df <- HARLOC_sub_co() %>% filter(id_center == loc)
+ tab <- df %>%
+ group_by(dates = floor_date(consultation_date, "month")) %>%
+ summarize(counts=n()) %>%
+ complete(dates = seq.Date(date1(), date2(), by = "month"), fill = list(counts = 0))
+ loc_name <- HARLOC_health_center_co[which(HARLOC_health_center_co$id_center == loc), "name"]
+ plot_incidence <- add_trace(plot_incidence, data = tab, x = ~dates, y = ~counts,
+ type = 'scatter', mode = 'lines', name = paste0(loc_name, " (CO)"))
+ }
+ # Brazil
+ for(loc in unique(HARLOC_sub_br()$id_center)){
+ df <- HARLOC_sub_br() %>% filter(id_center == loc)
+ tab <- df %>%
+ group_by(dates = floor_date(consultation_date, "month")) %>%
+ summarize(counts=n()) %>%
+ complete(dates = seq.Date(date1(), date2(), by = "month"), fill = list(counts = 0))
+ loc_name <- HARLOC_health_center_br[which(HARLOC_health_center_br$id_center == loc), "name"]
+ plot_incidence <- add_trace(plot_incidence, data = tab, x = ~dates, y = ~counts,
+ type = 'scatter', mode = 'lines', name = paste0(loc_name, " (BR)"))
+ }
+ }
+ # Add similar blocks for other aggregation periods (1, 6, 90, 366)
+ }
+ # Add similar blocks for residence_area and infection_place
+
+ return(plot_incidence)
+})
+
+# Information completeness
+output$HARLOC_information_completness <- renderUI({
+ tabBox(
+ width = 12,
+ height = "180px",
+ title = tr("missing_information"),
+ tabPanel(
+ title = tr("infection_place"),
+ valueBox(paste0(round(HARLOC_sub_infqual_co()["infection_place"],2),"%"), tr("CO"), color = "purple", width = 6),
+ valueBox(paste0(round(HARLOC_sub_infqual_br()["infection_place"],2),"%"), tr("BR"), color = "purple", width = 6)
+ ),
+ tabPanel(
+ title = tr("residence_area"),
+ valueBox(paste0(round(HARLOC_sub_infqual_co()["residence_place"],2),"%"), tr("CO"), color = "purple", width = 6),
+ valueBox(paste0(round(HARLOC_sub_infqual_br()["residence_place"],2),"%"), tr("BR"), color = "purple", width = 6)
+ ),
+ tabPanel(
+ title = tr("center"),
+ valueBox(paste0(round(HARLOC_sub_infqual_co()["id_center"],2),"%"), tr("CO"), color = "purple", width = 6),
+ valueBox(paste0(round(HARLOC_sub_infqual_br()["id_center"],2),"%"), tr("BR"), color = "purple", width = 6)
+ )
+ )
+})
+
+# Calendar heatmaps
+output$HARLOC_plot_day_week_br <- renderPlot({
+ if(length(HARLOC_br_tab_day_week() > 0)){
+ calendarHeat(dates = HARLOC_br_tab_day_week()$dates,
+ values = HARLOC_br_tab_day_week()$counts,
+ color="g2r")
+ } else {
+ plot.new()
+ }
+})
+
+output$HARLOC_plot_day_week_co <- renderPlot({
+ if(length(HARLOC_co_tab_day_week() > 0)){
+ calendarHeat(dates = HARLOC_co_tab_day_week()$dates,
+ values = HARLOC_co_tab_day_week()$counts,
+ color="g2r")
+ } else {
+ plot.new()
+ }
})
\ No newline at end of file
diff --git a/modules/map.R b/modules/map.R
index 6bb075b..1cdd283 100644
--- a/modules/map.R
+++ b/modules/map.R
@@ -1,87 +1,35 @@
-### Map tab
-
-avg.formula =
- "function (cluster) {
-var markers = cluster.getAllChildMarkers();
-var sum = 0;
-var count = 0;
-var avg = 0;
-var mFormat = ' marker-cluster-';
-for (var i = 0; i < markers.length; i++) {
-if(markers[i].options.weight != undefined){
-sum += markers[i].options.weight;
-count += 1;
-}
-}
-//avg = Math.round(sum/count);
-avg = sum;
-if(avg<500) {mFormat+='small'} else if (avg>10000){mFormat+='large'}else{mFormat+='medium'};
-return L.divIcon({ html: '<div><span>' + avg + '</span></div>', className: 'marker-cluster'+mFormat, iconSize: L.point(40, 40) });
-}"
-
-### limites Guyane - Oiapoque
-f_lim_guyam <- "data/shp/guy-oiapoque_final.shp"
-lim_guyam <- sf::st_read(f_lim_guyam, quiet = TRUE) %>%
- st_transform(crs=4326)
-
-### OSM data 2022
-
-f_hosp <- "data/osm/hospital_guyamapa.osm"
-f_clin <- "data/osm/clinic_guyamapa.osm"
-
-query_update <- FALSE
-if (query_update) {
- bbox_guyam <- "(-1.24,-54.88,5.78,-49.34)"
- q_hosp_guyam <- paste0(
- "( nwr[amenity=hospital]", bbox_guyam, "; ); out center;")
- q_clin_guyam <- paste0(
- "( nwr[amenity=clinic]", bbox_guyam, "; ); out center;")
- result_hosp <- osmdata_xml(q_hosp_guyam, filename=f_hosp)
- result_clin <- osmdata_xml(q_clin_guyam, filename=f_clin)
-}
-
-# read osm points
-hospital <- sf::st_read(f_hosp, layer = 'points', quiet = TRUE)
-clinica <- sf::st_read(f_clin, layer = 'points', quiet = TRUE)
-hospital_icon <- makeIcon(
- iconUrl = 'data/svg/circle-h-solid.svg', iconWidth = 20, iconHeight = 20)
-clinica_icon <- makeIcon(
- iconUrl='data/svg/house-medical-solid.svg', iconWidth = 20, iconHeight = 20)
-
-### data wms cayenne 2022
-url_wms <- paste0(
- "https://cartogy.cayenne.ird.fr/index.php/lizmap/service/",
- "?repository=risquepalu&project=progysat_carto_risque_lizmap&SERVICE=WMS"
+# Définition des limites de la zone d'étude
+# Coordonnées approximatives de la zone tri-frontalière
+tri_frontier_coords <- matrix(c(
+ -70.5, -3.9, # Nord-Ouest
+ -69.5, -3.9, # Nord-Est
+ -69.5, -4.5, # Sud-Est
+ -70.5, -4.5, # Sud-Ouest
+ -70.5, -3.9 # Fermer le polygone
+), ncol = 2, byrow = TRUE)
+
+# Création d'un objet sf simple pour les limites
+lim_guyam <- st_sf(
+ geometry = st_sfc(st_polygon(list(tri_frontier_coords))),
+ crs = 4326
)
-### data GBIF
-url_anopheles_darlingi <- paste0(
- "https://api.gbif.org/v2/map/occurrence/density/{z}/{x}/{y}@1x.png?",
- "style=classic.poly&bin=hex&hexPerTile=17&taxonKey=1650149&srs=EPSG:3857")
-
-url_anopheles_marajoara <- paste0(
- "https://api.gbif.org/v2/map/occurrence/density/{z}/{x}/{y}@1x.png?",
- "style=classic.poly&bin=hex&hexPerTile=17&taxonKey=1650776&srs=EPSG:3857")
-
-output$MAPmissing <- renderText("")
+# Fonction réactive pour préparer les données de la carte
df_map <- reactive({
map_dates <- req(input$MAPdates)
map_type <- req(input$MAPtype)
map_diagn <- req(input$MAPdiagn)
- # print("**df_map**")
- # print(map_dates)
- # print(map_type)
-
date1 <- as.Date(paste0(map_dates[1],"-01-01"))
date2 <- as.Date(paste0(map_dates[2],"-12-31"))
if(map_type == "residence_area"){
- df <- consultation_har_filter(
- JSON_cons_har, new_attack="Any",
+ df <- consultation_har_filter(
+ JSON_cons_har,
+ new_attack = "Any",
diagn = map_diagn
) %>%
filter(consultation_date >= date1 & consultation_date <= date2) %>%
@@ -89,42 +37,68 @@ df_map <- reactive({
inner_join(coords, by = c("residence_place" = "id")) %>%
mutate(id = residence_place)
- missing_total <- JSON_cons_har %>%
- filter(consultation_date >= date1 & consultation_date <= date2) %>%
- nrow()
-
- # missing_per <- round((sum(df$count)/missing_total)*100, 2)
- # missing_n <- sum(df$count)
} else if(map_type == "infection_place"){
- df <- consultation_har_filter(
- JSON_cons_har, new_attack="Any",
+ df <- consultation_har_filter(
+ JSON_cons_har,
+ new_attack = "Any",
diagn = map_diagn
) %>%
filter(consultation_date >= date1 & consultation_date <= date2) %>%
select(infection_place, source) %>%
inner_join(coords, by = c("infection_place" = "id")) %>%
mutate(id = infection_place)
+ }
+
+ return(df)
+})
+
+# Rendu de la carte
+# Fonction réactive pour préparer les données de la carte
+df_map <- reactive({
+
+ map_dates <- req(input$MAPdates)
+ map_type <- req(input$MAPtype)
+ map_diagn <- req(input$MAPdiagn)
+
+ date1 <- as.Date(paste0(map_dates[1],"-01-01"))
+ date2 <- as.Date(paste0(map_dates[2],"-12-31"))
+
+ if(map_type == "residence_area"){
+ df <- consultation_har_filter(
+ JSON_cons_har,
+ new_attack = "Any",
+ diagn = map_diagn
+ ) %>%
+ filter(consultation_date >= date1 & consultation_date <= date2) %>%
+ select(residence_place, source) %>%
+ inner_join(coords, by = c("residence_place" = "id")) %>%
+ mutate(id = residence_place)
- missing_total <- JSON_cons_har %>%
+ } else if(map_type == "infection_place"){
+ df <- consultation_har_filter(
+ JSON_cons_har,
+ new_attack = "Any",
+ diagn = map_diagn
+ ) %>%
filter(consultation_date >= date1 & consultation_date <= date2) %>%
- nrow()
+ select(infection_place, source) %>%
+ inner_join(coords, by = c("infection_place" = "id")) %>%
+ mutate(id = infection_place)
}
return(df)
})
+# Rendu de la carte
output$map <- renderLeaflet({
+ req(df_map()) # S'assurer que les données sont disponibles
- # reinit map on language change !
- lang <- req(input$language)
- print(lang)
-
- dados_mapa <- isolate(df_map())
- pal <- colorFactor(c("red","blue"), dados_mapa$source)
+ dados_mapa <- df_map()
+ pal <- colorFactor(c("red", "blue"), dados_mapa$source)
leaflet() %>%
addTiles(options = providerTileOptions(maxZoom = 12), group = "OSM Tiles") %>%
- setView(lng = -51.548, lat = 3.938, zoom = 9) %>%
+ setView(lng = -69.9456, lat = -4.2078, zoom = 8) %>%
addMapPane("pane_lim", zIndex = 395) %>%
addMapPane("pane_an_darlingi", zIndex = 400) %>%
addMapPane("pane_clinic", zIndex = 410) %>%
@@ -139,118 +113,80 @@ output$map <- renderLeaflet({
fillOpacity = 0.05,
options = pathOptions(pane = "pane_lim")
) %>%
- addTiles(
- urlTemplate = url_anopheles_darlingi,
- attribution = "GBIF",
- layerId = "GBIF_Anopheles_Darlingi",
- group = "GBIF_An_Darlingi",
- options = tileOptions(pane = "pane_an_darlingi")
+ # Villes principales de la tri-frontière
+ addMarkers(
+ lng = -69.9456, lat = -4.2078,
+ label = "Leticia (CO)",
+ group = "Cities"
) %>%
addMarkers(
- data = clinica, group = "Clinics", icon = clinica_icon,
- popup = ~name,
- options = markerOptions(opacity=0.8, pane = "pane_clinic")) %>%
+ lng = -69.9388, lat = -4.2333,
+ label = "Tabatinga (BR)",
+ group = "Cities"
+ ) %>%
addMarkers(
- data = hospital, group = "Hospitals", icon = hospital_icon,
- popup = ~name,
- options = markerOptions(pane = "pane_hospital")) %>%
- clearGroup("Dados") %>%
+ lng = -69.9611, lat = -4.2172,
+ label = "Santa Rosa (PE)",
+ group = "Cities"
+ ) %>%
+ # Données des cas
addCircleMarkers(
data = dados_mapa,
lat = ~y_coordinate,
lng = ~x_coordinate,
color = ~pal(source),
- stroke = FALSE, fillOpacity = 0.5,
+ stroke = FALSE,
+ fillOpacity = 0.5,
clusterOptions = markerClusterOptions(spiderfyOnMaxZoom = FALSE),
options = pathOptions(pane = "pane_cases"),
- group = "Dados") %>%
- hideGroup(
- c("Clinics", "Hospitals", "GBIF_An_Darlingi"))
-
+ group = "Dados",
+ label = ~paste0(name, " (", source, ")")
+ ) %>%
+ addLegend(
+ "bottomright",
+ pal = pal,
+ values = dados_mapa$source,
+ title = "Source",
+ opacity = 0.7
+ )
})
-# Interactive populate
+# Observer pour mettre à jour la carte quand les filtres changent
observe({
- print("MAP observeEvent")
- df <- df_map()
- print(nrow(df))
- # Map
- pal <- colorFactor(c("red","blue"), df$source)
- leafletProxy("map", data = df) %>%
+ dados_mapa <- df_map()
+ pal <- colorFactor(c("red", "blue"), dados_mapa$source)
+
+ leafletProxy("map", data = dados_mapa) %>%
clearGroup("Dados") %>%
- # clearShapes() %>%
- # clearMarkers() %>%
- # clearMarkerClusters() %>%
addCircleMarkers(
- data = df,
lat = ~y_coordinate,
lng = ~x_coordinate,
color = ~pal(source),
- stroke = FALSE, fillOpacity = 0.5,
+ stroke = FALSE,
+ fillOpacity = 0.5,
clusterOptions = markerClusterOptions(spiderfyOnMaxZoom = FALSE),
- group = "Dados"
+ options = pathOptions(pane = "pane_cases"),
+ group = "Dados",
+ label = ~paste0(name, " (", source, ")")
)
-
})
+# Observer pour mettre à jour la carte quand les filtres changent
observe({
- val <- input$MAPosm
- mapobj <- leafletProxy("map")
- if ("Hospitals" %in% val) {
- mapobj %>% showGroup("Hospitals")
- } else {
- mapobj %>% hideGroup("Hospitals")
- }
- if ("Clinics" %in% val) {
- mapobj %>% showGroup("Clinics")
- } else {
- mapobj %>% hideGroup("Clinics")
- }
-})
-
-observe({
- val <- input$MAPgbif
- if ("Anopheles darlingi" %in% val) {
- leafletProxy("map") %>% showGroup("GBIF_An_Darlingi")
- } else {
- leafletProxy("map") %>% hideGroup("GBIF_An_Darlingi")
- }
-})
-
-# Interactive WMS Layers
-observeEvent(input$MAPrasters, {
- layer_wms <- req(input$MAPrasters)
- print(paste("MAPrasters", ":", layer_wms))
- proxy_map <- leafletProxy("map", data = df)
- if (layer_wms=="NO_SEL") {
- proxy_map %>% clearGroup("WMS_Raster")
- } else {
- proxy_map %>%
- clearGroup("WMS_Raster") %>%
- addWMSTiles(
- url_wms,
- layers = layer_wms,
- options = WMSTileOptions(
- format = "image/png", opacity=0.8, transparent = TRUE),
- attribution = "UMR Espace-Dev",
- group = "WMS_Raster"
- )
- }
-})
-
-output$MAPlegend <- renderUI({
- layer_wms <- req(input$MAPrasters)
- if (layer_wms=="NO_SEL") {
- html_output <- ""
- } else {
- html_output <- img(src=paste0(
- "https://cartogy.cayenne.ird.fr/index.php/lizmap/service/?",
- "repository=risquepalu&project=progysat_carto_risque_lizmap&",
- "SERVICE=WMS&VERSION=1.3.0&REQUEST=GetLegendGraphic&",
- "LAYER=", layer_wms, "&",
- "FORMAT=image/png&STYLE=padrão&SLD_VERSION=1.1.0&",
- "ITEMFONTSIZE=9&SYMBOLSPACE=1&ICONLABELSPACE=2&DPI=96&LAYERSPACE=0&",
- "LAYERFONTBOLD=FALSE&LAYERTITLE=FALSE"))
- }
- html_output
+ dados_mapa <- df_map()
+ pal <- colorFactor(c("red", "blue"), dados_mapa$source)
+
+ leafletProxy("map", data = dados_mapa) %>%
+ clearGroup("Dados") %>%
+ addCircleMarkers(
+ lat = ~y_coordinate,
+ lng = ~x_coordinate,
+ color = ~pal(source),
+ stroke = FALSE,
+ fillOpacity = 0.5,
+ clusterOptions = markerClusterOptions(spiderfyOnMaxZoom = FALSE),
+ options = pathOptions(pane = "pane_cases"),
+ group = "Dados",
+ label = ~paste0(name, " (", source, ")")
+ )
})
--
GitLab