Skip to content
Snippets Groups Projects
map.R 7.49 KiB
Newer Older
Vincent DUPONT's avatar
Vincent DUPONT committed
### 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"
)

### 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("")

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",
      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 %>%
      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",
      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)
    
    missing_total <- JSON_cons_har %>%
      filter(consultation_date >= date1 & consultation_date <= date2) %>%
      nrow()
  }
  
  return(df)
})

output$map <- renderLeaflet({
  
  # reinit map on language change !
  lang <- req(input$language)
  print(lang)
  
  dados_mapa <- isolate(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) %>%
    addMapPane("pane_lim", zIndex = 395) %>%
    addMapPane("pane_an_darlingi", zIndex = 400) %>%
    addMapPane("pane_clinic", zIndex = 410) %>%
    addMapPane("pane_hospital", zIndex = 415) %>%
    addMapPane("pane_cases", zIndex = 420) %>%
    addPolygons(
      data = lim_guyam, 
      color = "#444444", 
      weight = 1, 
      smoothFactor = 0.5,
      opacity = 1.0, 
      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")
    ) %>%
    addMarkers(
      data = clinica, group = "Clinics", icon = clinica_icon,
      popup = ~name, 
      options = markerOptions(opacity=0.8, pane = "pane_clinic")) %>%
    addMarkers(
      data = hospital, group = "Hospitals", icon = hospital_icon,
      popup = ~name, 
      options = markerOptions(pane = "pane_hospital")) %>%
    clearGroup("Dados") %>%
    addCircleMarkers(
      data = dados_mapa,
      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") %>%
    hideGroup(
      c("Clinics", "Hospitals", "GBIF_An_Darlingi"))
  
})

# Interactive populate
observe({
  print("MAP observeEvent")
  df <- df_map()
  print(nrow(df))
  # Map
  pal <- colorFactor(c("red","blue"), df$source)
  leafletProxy("map", data = df) %>%
    clearGroup("Dados") %>%
    # clearShapes() %>%
    # clearMarkers() %>%
    # clearMarkerClusters() %>%
    addCircleMarkers(
      data = df,
      lat = ~y_coordinate,
      lng = ~x_coordinate,
      color = ~pal(source),
      stroke = FALSE, fillOpacity = 0.5,
      clusterOptions = markerClusterOptions(spiderfyOnMaxZoom = FALSE),
      group = "Dados"
    )
  
})

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
})