This is a supplementary example for the leaflet-intro session.

Basic Map

Load libraries

library(dplyr)
library(leaflet)
library(sf)
# library(htmlwidgets)

Load point data

hospitals_bogota <- readRDS(file = "data/hospitals_bogota.rds")

Data wrangling - point data

hospitals_bogota <- hospitals_bogota %>% 
  mutate(lat = as.numeric(Latitude), long = as.numeric(Longitude)) %>% 
  select(-c(CITY, pais, SurgRms, IntensRms, EmergRms, CTRYISOA3, ADM1ISOC, ADM1ISON, SubRegion, PRIORITY, Map, Latitude, Longitude)) %>% 
  st_as_sf(coords = c("long", "lat"), crs = 4326)

Mapping hospital’s location (as points)

# Create a palette that maps factor levels to colors
pal <- colorFactor(c("#d8b365", "#5ab4ac"), 
                   domain = c("Public - Ministry of Health ", "Private"))

leaflet(data = hospitals_bogota) %>% 
  addProviderTiles(providers$CartoDB) %>% 
  addCircleMarkers(radius = 8, 
                   color = ~pal(H_Sector), 
                   fillOpacity = 0.9, 
                   stroke = FALSE, 
                   label = ~Hospital_name, 
                   popup = paste0("Surgery Rooms:", hospitals_bogota$SurgeryRm)) %>%
  addLegend(pal = pal, 
            values = ~H_Sector, 
            opacity = 0.9,
            title = "Hospital Sector")

Now same map but considering other attributes and visual variables.

pal <- colorFactor(c("#d8b365", "#5ab4ac"), 
                   domain = c("Public - Ministry of Health ", "Private"))

addLegendCustom <- function(map, color, labels, sizes, opacity = 0.8, stroke, title = "Hospital Level"){
  colorAdditions <- paste0(color, "; border-radius: 50%; width:", sizes, "px; height:", sizes, "px")
  labelAdditions <- paste0("<div style='display: inline-block;height: ", 
                           sizes, "px;margin-top: 4px;line-height: ", sizes, "px;'>", 
                           labels, "</div>")
  return(addLegend(map, 
                   colors = colorAdditions, 
                   labels = labelAdditions, 
                   opacity = opacity, 
                   title = title))
}

leaflet(data = hospitals_bogota) %>% 
  addProviderTiles(providers$CartoDB) %>% 
  addCircleMarkers(radius = ~ifelse(H_Level == "SMALL - General surgery and open 24 hrs", 4, 
                                    ifelse(H_Level == "MEDIUM -Two Specialty services", 8, 15)), 
                   color = ~pal(H_Sector), 
                   fillOpacity = 0.9, 
                   stroke = FALSE, 
                   label = ~Hospital_name, 
                   popup = paste0("Surgery Rooms:", hospitals_bogota$SurgeryRm)) %>%
  addLegendCustom(color = "gray", 
                  labels = c("Small - General surgery and open 24 hrs", 
                             "Medium -Two Specialty services", 
                             "Big - High medical specialties"), 
                  sizes = c(8, 15, 25), 
                  stroke = FALSE) %>%
  addLegend(pal = pal, 
            values = ~H_Sector, 
            opacity = 0.9, 
            title = "Hospital Sector")

Adding Polygons

Load seismis hazard information (polygons representing hazard areas)

seismic_hazard <- read_sf("https://datosabiertos.bogota.gov.co/dataset/b3d097e8-0d97-44f5-90d7-e7d73530c33f/resource/62cc3e17-a69a-45de-a1cb-4ade5867c1ed/download/respuesta-sismica.geojson") %>%
  st_transform(4326) # From EPSG:3857 (a Spherical Mercator projection coordinate system) to WGS84

Reclassify hazard areas

seismic_hazard <- seismic_hazard %>%
  select(OBJECTID, RESSIS) %>%
   mutate(reclass = ifelse(RESSIS == "Aluvial 50" | RESSIS == "Aluvial 100" | RESSIS == "Aluvial 200" | RESSIS == "Aluvial 300", "Aluvial",
                        ifelse(RESSIS == "Piedemonte A" | RESSIS == "Piedemonte B" | RESSIS == "Piedemonte C", "Piedemonte",
                               ifelse(RESSIS == "Lacustre Aluvial 200" | RESSIS == "Lacustre Aluvial 300", "Lacustre Aluvial",
                                             ifelse(RESSIS == "Depósito Ladera", "Deposito Ladera",
                                                    ifelse(RESSIS == "Cerros", "Cerros", "Lacustre"))))))

Put hospital’s data together with seismic hazard information

# Hospitals legend
pal <- colorFactor(c("#d8b365", "#5ab4ac"), 
                   domain = c("Public - Ministry of Health ", "Private"))

addLegendCustom <- function(map, color, labels, sizes, opacity = 0.8, stroke, title = "Hospital Level"){
  colorAdditions <- paste0(color, "; border-radius: 50%; width:", sizes, "px; height:", sizes, "px")
  labelAdditions <- paste0("<div style='display: inline-block;height: ", 
                           sizes, "px;margin-top: 4px;line-height: ", sizes, "px;'>", 
                           labels, "</div>")

  return(addLegend(map, colors = colorAdditions, 
                   labels = labelAdditions, opacity = opacity, title = title))
}

# Hazard legend
pal_hazard <- colorFactor(c("#8c510a", "#1b7837", "#e08214", "#d73027", "#4575b4", "#fed976"), 
                   domain = c("Aluvial", "Lacustre Aluvial", "Cerros", "Deposito Ladera", "Piedemonte", "Lacustre"))
#"#8c510a-brown", "#1b7837-green", "#4575b4-blue", "#e08214-orange", "#fed976-yellow", "#d73027-red"


map <- leaflet(data = hospitals_bogota) %>% 
  addProviderTiles(providers$CartoDB) %>%  
  addPolygons(data = seismic_hazard , 
              stroke = FALSE, 
              fillOpacity = 0.5,
              fillColor = ~pal_hazard(reclass),
              label = ~reclass) %>% 
  addCircleMarkers(radius = ~ifelse(H_Level == "SMALL - General surgery and open 24 hrs", 4, 
                                    ifelse(H_Level == "MEDIUM -Two Specialty services", 8, 15)), 
                   color = ~pal(H_Sector), 
                   fillOpacity = 0.9, 
                   stroke = FALSE, 
                   label = ~Hospital_name, 
                   popup = paste0("Surgery Rooms:", hospitals_bogota$SurgeryRm)) %>%
  addLegendCustom(color = "gray", 
                  labels = c("Small - General surgery and open 24 hrs", 
                             "Medium -Two Specialty services", 
                             "Big - High medical specialties"), 
                  sizes = c(8, 15, 25), 
                  stroke = FALSE) %>%
  addLegend(pal = pal, 
            values = ~H_Sector, 
            opacity = 0.9, 
            title = "Hospital Sector") %>% 
  addLegend(pal = pal_hazard, 
            values = ~seismic_hazard$reclass,
            title = "Seismic Hazard",
            position = "bottomright") 

# saveWidget(map, file="Map_Hospitals_Bogota.html")
map

Creating a Map Function

Prepare a map function to be used in an upcoming shiny app

hospital_map = function(hospital_level){
  pal <- colorFactor(c("#d8b365", "#5ab4ac"), 
                   domain = c("Public - Ministry of Health ", "Private")) 
  pal_hazard <- colorFactor(c("#8c510a", "#1b7837", "#e08214", "#d73027", "#4575b4", "#fed976"), 
                   domain = c("Aluvial", "Lacustre Aluvial", "Cerros", "Deposito Ladera", "Piedemonte", "Lacustre"))
  leaflet(data = hospitals_bogota %>% 
          filter(H_Level == hospital_level)) %>% 
  addProviderTiles(providers$CartoDB.DarkMatter) %>% 
  addPolygons(data = seismic_hazard , 
              stroke = FALSE, 
              fillOpacity = 0.5,
              fillColor = ~pal_hazard(reclass),
              label = ~reclass)  %>% 
  addCircleMarkers(color = ~pal(H_Sector), 
                   fillOpacity = 0.9, 
                   stroke = FALSE, 
                   label = ~Hospital_name,
                   popup = paste0("Surgery Rooms:", hospitals_bogota$SurgeryRm))%>%
  addLegend(pal = pal_hazard, 
            values = ~seismic_hazard$reclass, 
            title = "Seismic Hazard") %>%
  addLegend(pal = pal, 
            values = ~H_Sector, 
            title = "Hospital Sector")
}