The [leaflet]() package allows to create interactive maps with only a couple of lines of code. JS library that using the [htmlwidgets]() package. With the additional help of the [crosstalk]() we can also add ...
There are three steps that are required to create an interactive web map in R using leaflet:
- load the [sp](), or the [sf](), package
- load the boundaries that define the polygons object of the thematic map
- load the `leaflet` library
- initialize the leaflet widget using the `leaflet()` function. Notice that the call does not actually require any argument at this point. They will be added in a way similar to the [ggplot]() *summation*, but using instead the *pipe* operator `%>%` from the [magrittr]() package that allows to chain function calls together without having to store the intermediate output in a temporary object. It is possible to pass an optional list of general options, among which it's worth mention the following:
- add a map *tile*, using the `addTiles()` function, to add the default [OpenStreetMap]() (OSM) tile to the map or any tile using the , or the `addProviderTiles()` function, that allows to add one of the 100+ tiles referenced in the included `providers` list by simply using the name of the chosen element as argument. To search for all included versions from a provider, just use
```
names(providers)[str_detect(names(providers), 'provider_name')]`
```
Notice that while most tiles are open source and free to use as they are, some are connected to services that need at least a registration, and often also to request an API_key to monitor the usage.
Map tiles weave multiple map images together. The map tiles presented adjust when a user zooms or pans the map enabling the interactive features.
- set the extent of the map using one of the two following functions:
`fitBounds(lat = , lng = , lat = , lng = )`
`setView(lat = , lng = , zoom = )`
At this point it could be useful to use the geocode() function from the ggmap package that returns the possible coordinates for any location in the world using the [Google Ma
- add the point(s), using the
- add the polygon(s), using the `addPolygons` function
- add the legend
- add
If the map is included in a shiny app, and the map has to react to some input, some precautions has to be taken, to avoid the user to wait for a complete reloading oof the map while actually the only thing to be done is a change in style
- load packages
```
lapply( c('data.table', 'leaflet', 'RColorBrewer', 'rgdal'), require, char = TRUE )
```
Let's recall how to load
- Read boundaries as separate objects from shapefiles stored in some shp_path directory
```
boundaries <- lapply(loca.map, function(x) readOGR(shp_path, x))
names(boundaries) <- loca.map
for(m in loca.map){
boundaries[[m]] <- merge(boundaries[[m]], areas[, .(ons_id, nhs_id, name)], by.x = 'id', by.y = 'ons_id')
boundaries[[m]] <- merge(boundaries[[m]], centres[get(audit) == 1, .(H = .N), .(ons_id = get(paste0(m, '_ons')))], by.x = 'id', by.y = 'ons_id')
}
```
Read boundaries as a unique list object from rds shared rep
```
boundaries <- readRDS(paste0(data.path, 'boundaries.rds'))
for(m in loca.map){
boundaries[[m]] <- merge(boundaries[[m]], centres[get(audit) == 1, .(H = .N), .(ons_id = get(paste0(m, '_ons')))], by.x = 'id', by.y = 'ons_id')
}
```
```
bnd <- boundaries[[loca.ini]]
if(length(boundaries[[input$cbo_hsp_geo]]) > 0) bnd <- boundaries[[input$cbo_hsp_geo]]
bnd.void <- subset(bnd, is.na(bnd$H))
bnd.ok <- subset(bnd, !is.na(bnd$H))
pal <- colorNumeric(palette = brewer.pal(3, pal.ini), domain = 1:max(bnd.ok$H, na.rm = TRUE), na.color = 'grey')
leaflet(bnd) %>%
fitBounds(lng1 = 1.8, lat1 = 49.9, lng2 = -8.3, lat2 = 58.0 ) %>%
addTiles(tile.ini) %>%
addPolygons(data = bnd.void, group = 'poly.void',
stroke = TRUE,
color = '#444444',
opacity = 1.0,
weight = 0.6,
smoothFactor = 0.5,
fill = TRUE,
fillColor = 'grey',
fillOpacity = 0.4,
highlightOptions = highlightOptions(
color = 'red',
weight = 3,
bringToFront = TRUE
),
label = lapply(1:length(bnd.void), function(x) HTML(paste0(bnd.void$name[x], ' (', bnd.void$nhs_id[x], '). ', 'Not Supported') ) ),
labelOptions = labelOptions(
textsize = '12px',
direction = 'auto',
style = list('font-weight' = 'normal', 'padding' = '2px 6px')
)
) %>%
addPolygons(data = bnd.ok, group = 'poly.ok',
stroke = TRUE,
color = '#444444',
opacity = 1.0,
weight = 0.6,
smoothFactor = 0.5,
fill = TRUE,
fillColor = ~pal(H),
fillOpacity = 0.4,
highlightOptions = highlightOptions(
color = 'white',
weight = 5,
bringToFront = TRUE
),
label = lapply(1:length(bnd), function(x) HTML(paste0(bnd.ok$name[x], ' (', bnd.ok$nhs_id[x], '). Hospitals:', bnd.ok$H[x], '') ) ),
labelOptions = labelOptions(
textsize = '12px',
direction = 'auto',
style = list('font-weight' = 'normal', 'padding' = '2px 6px')
)
) %>%
addLegend(
pal = pal,
values = ~H,
title = 'N Centres',
position = 'bottomright',
opacity = 0.8
)
})
# Merge boundaries with chosen data. ===>>> NEEDS tweak for names when missing data <<<===
hsp_map_bnd <- reactive({
bnd <- boundaries[[input$cbo_hsp_geo]]
bnd <- subset(bnd, !is.na(bnd$H))
merge(bnd, dt_hsp_map_plg(), by.x = 'id', by.y = 'Wo', all.x = FALSE)
})
# Determine the number of different classes
n.col <- reactive({
min(length(unique(hsp_map_bnd()$Y)), input$sld_hsp_map_Ycn, brewer.pal.info[input$pal_hsp_mapY, 'maxcolors'])
})
# Determine the values for the bins
brks <- reactive({
classIntervals(hsp_map_bnd()$Y, n = n.col(), style = input$cbo_hsp_map_Ycl)
})
# Determine the colors to use
col_codes <- reactive({
y <- brewer.pal(n = n.col(), name = input$pal_hsp_mapY)[1:n.col()]
if(input$chk_hsp_mapY_rvc) y <- rev(y)
y
})
# associate colors and classes
colorpal <- reactive({
findColours(brks(), col_codes())
})
# Update changes in Tiles
observe({
proxy <- leafletProxy('out_hsp_map')
proxy %>% clearTiles()
proxy %>% addTiles(input$cbo_hsp_map_tls)
})
# Update changes In Polygons
observe({
if(input$cbo_hsp_mapY != 'NONE'){
pal <- colorpal()
bnd <- hsp_map_bnd()
leafletProxy('out_hsp_map') %>%
clearGroup('poly.ok') %>%
addPolygons(data = bnd, group ='poly.ok',
stroke = TRUE,
color = input$col_hsp_mapY_bcl,
opacity = 1.0,
weight = as.integer(input$sld_hsp_mapY_bsz) / 10,
smoothFactor = 0.5,
fill = TRUE,
fillColor = pal,
fillOpacity = 1 - as.integer(input$sld_hsp_mapY_trp) / 10,
highlightOptions = highlightOptions(
color = 'white',
weight = 3,
bringToFront = TRUE
),
label = lapply(bnd$ttip, HTML),
labelOptions = labelOptions(
textsize = '15px',
direction = 'auto',
style = list('font-weight' = 'normal', 'padding' = '3px 8px')
)
)
}
})
# Draw / Clear Polygons Legend
observe({
if(input$cbo_hsp_mapY != 'NONE'){
pal <- colorpal()
bnd <- hsp_map_bnd()
proxy <- leafletProxy('out_hsp_map')
proxy %>% clearControls()
if(input$chk_hsp_map_lgn){
# mtc.type <- metrics[label == input$cbo_hsp_mapY, type]
# lbl.brks <- brks()[[2]]
# if(mtc.type == 1){
# lbl.brks <- format(round(lbl.brks, 0), big.mark = ',')
# } else if(mtc.type == 2){
# lbl.brks <- format(round(100*lbl.brks, 2), nsmall = 2)
# } else {
# lbl.brks <- format(round(lbl.brks, 1), nsmall = 1)
# }
# lbl.text <- sapply(2:n.col(),
# function(x)
# paste0(
# lbl.brks[x-1], ' \u2264 n < ', lbl.brks[x],
# ' (', length(bnd$Y[bnd$Y >= as.numeric(gsub(',', '', lbl.brks[x-1])) & bnd$Y < as.numeric(gsub(',', '', lbl.brks[x])) ] ), ')'
# )
# )
# lbl.text <- c(lbl.text,
# paste0(
# lbl.brks[n.col()], ' \u2264 n \u2264 ', lbl.brks[n.col() + 1],
# ' (', length(bnd$Y[bnd$Y >= as.numeric(gsub(',', '', lbl.brks[n.col()])) & bnd$Y <= as.numeric(gsub(',', '', lbl.brks[n.col() + 1])) ] ), ')'
# )
# )
lbl.text <- get.legend.colnames(bnd, metrics[label == input$cbo_hsp_mapY, type], brks()[[2]], n.col())
proxy %>%
addLegend(
colors = col_codes(),
labels = lbl.text,
title = metrics[label == input$cbo_hsp_mapY, title],
position = input$cbo_hsp_map_lgn,
opacity = 1 - as.integer(input$sld_hsp_mapY_trp) / 10
)
}
}
})
# Update Markers: Hospitals points / icons, with correspondin Size / Colours Metrics
observe({
proxy <- leafletProxy('out_hsp_map')
proxy %>% clearMarkers()
if(input$chk_hsp_map_hsp){
proxy %>%
addAwesomeMarkers(data = centres,
lng = ~X_lon, lat = ~Y_lat,
label = ~as.character(HSP_id),
labelOptions = labelOptions(
opacity = 0.8
),
popup = ~as.character(paste(HSP_id, '-', HSP)),
popupOptions = labelOptions(
opacity = 0.8
),
icon = hsp.icons
)
}
})
```
It is possible to embed any table, chart, htmlwidget or image in any popup using the appropriate `popup*` functionality from the **mapview** package:
- `popupTable(x, zcol, row.numbers = TRUE)`: to embed any chartacter vector
- `popupGraph(graphs, type = c("png", "svg", "html"), width = 300, height = 300, ...)`: to embed lattice, ggplot2 or interactive hatmlwidgets.
- `popupImage(img, src = c("local", "remote"), ...)`: to embed local or remote (web) images
- `popupIframe(url, width = 300, height = 300)`
To add more than one object, simply paste them together like in the following example:
```
library(DT)
library(ggplot2)
library(mapview)
library(leaflet)
y <- sf::st_set_geometry(breweries, NULL)
pop.tbl = popupGraph(datatable(y))
pop.plt = popupGraph(ggplot(y, aes(number.of.types)) + geom_bar())
pop.all = paste(pop.tbl[[1]], pop.plt[[1]])
leaflet() %>% addCircleMarkers(data = breweries, popup = pop.all)
```
It's also possible to add a *slide* chart of two different plots:
```
ggsave('img1.png', ggplot(y, aes(number.of.types)) + geom_bar())
ggsave('img2.png', ggplot(y, aes(number.seasonal.beers)) + geom_bar())
sld <- slideView('img1.png', 'img2.png', label1 = "before", label2 = "after")
leaflet() %>% addCircleMarkers(data = breweries, popup = popupGraph(sld, type = "html"))
```