R-leaflet.md

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], '). ', '<b>Not Supported</b>') ) ),
            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:<b>', bnd.ok$H[x], '</b>') ) ),
            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"))