r_mapping_leaflet-notes.R

# http://www.nytimes.com/projects/elections/2013/nyc-primary/mayor/map.html
# http://www.washingtonpost.com/sf/local/2013/11/09/washington-a-world-apart/?utm_term=.cc3aa0c4e149
# https://leanpub.com/leaflet-tips-and-tricks/read

library(rgdal)
library(leaflet)
library(mapview)
library(htmltools)


# colorBin, colorFactor, colorNumeric, colorQuantile
map.palette <- 'YlOrRd'
# tiles could be recalled either by including the URL of a particular service or by specifying the provider from the included list
tile <- 'http://tile.mtbmap.cz/mtbmap_tiles/{z}/{x}/{y}.png'

mp <- leaflet() %>%
        setView(lng = -2.421976, lat = 53.825564, zoom = 5) %>%
        fitBounds(lng1 = 1.8, lat1 = 49.9, lng2 = -8.3, lat2 = 59.0 ) %>%
#        addProviderTiles(providers$Stamen.TonerLite)
        addTiles(tile)
mp

# Tiles layers can also be combined, to multiple informations, using appropriately the opacity option
# mp %>%
#     addProviderTiles(providers$MtbMap, options = providerTileOptions(opacity = 0.7) ) %>%
#     addProviderTiles(providers$Stamen.TonerLines, options = providerTileOptions(opacity = 0.35)) %>%
#     addProviderTiles(providers$Stamen.TonerLabels)

db_conn <- dbConnect(MySQL(), group = 'shiny', dbname = 'geography')
centres <- suppressWarnings(data.table(dbReadTable(db_conn, 'centres'), key = 'HSP_id') )
dbDisconnect(db_conn)

# In general,
# - the label argument can be used to display a textual or HTML content either on hover or statically (option noHide is respectively FALSE (def) / TRUE)
# - the popup argument can be used to add a small box containing arbitrary HTML to be displayed on click
# Both above have a labelOptions = labelOptions(list of <name = value> options) to deeply customize

mp %>%
    addCircles(data = centres,
        lng = ~X_lon, lat = ~Y_lat,
        weight = 10,
        radius = 20,
        color = ~type + 1,
        label = ~as.character(HSP_id),
        labelOptions = labelOptions(
                            opacity = 0.8
        ),
        popup = ~as.character(paste(HSP_id, '-', HSP)),
        popupOptions = labelOptions(
                            opacity = 0.8
        )
    )

mp %>% addMarkers(data = centres,
        lng = ~X_lon, lat = ~Y_lat,
#        color = ~type,
        label = ~as.character(HSP_id),
        labelOptions = labelOptions(
                            opacity = 0.8
        ),
        popup = ~as.character(paste(HSP_id, '-', HSP)),
        popupOptions = labelOptions(
                            opacity = 0.8
        )
)

# It's possible to build own icons with the three built-in functions makeIcon, icons, and iconList
# It's possibly easier to start from the following three libraries:
# - fa: Font Awesome http://fontawesome.io/icons/,
# - glyphicon: Bootstrap Glyphicons https://getbootstrap.com/components/,
# - ion: Ion icons http://ionicons.com/,
# and using similar functions:
# - makeAwesomeIcon
# - awesomeIcons
# - awesomeIconList
#
hsp.icons <- awesomeIcons(
    icon = 'h-square',
    library = 'fa',
    squareMarker = TRUE,
    markerColor = sapply(centres$type, function(x) if(x == 1){ "lightgreen" } else { "lightred" }),
    iconColor = 'white'
)

mp %>% addAwesomeMarkers(data = centres,
        lng = ~X_lon, lat = ~Y_lat,
#        color = ~type,
        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
)



mp %>% addCircleMarkers(~long, ~lat, label = ...)

mp %>% addRectangles()

mp %>% addPolygons()

mp %>% addLabelOnlyMarkers(~long, ~lat, label = ...)

mp %>% addPopups(~long, ~lat, label = ...)

mp %>% addLegend()

mp %>% addLayersControl(
            baseGroups = c('grp1', 'grp2', ...),
            overlayGroups = c('grp1'),
            options = layersControlOptions(collapsed = FALSE)
)

# -------------------------------------------------------------------------------------------------------------------------------
# # # LET's ADD POLYGONS

# read boundaries
shp.path <- 'C:/projects/boundaries/shp'
boundaries <- lapply(c('CCG', 'LAT', 'NHSR', 'CCR', 'CTRY'), function(x) readOGR(shp.path, x))
names(boundaries) <- c('CCG', 'LAT', 'NHSR', 'CCR', 'CTRY')

area <- 'CCG'
metric <- 'No. pPCIs'
metric <- 'No. Cases Age > 80'
# y <- get.y.tms(dataset, 'Mean Euroscore', 'CCG_id', tt = c(NA, 'CCG'))
# pct <- FALSE
y <- get.y.tms(dataset, metric, paste0(area, '_id'), pct = TRUE)
pct <- TRUE
y <- merge(y, unique(hospitals[, .(X = get(paste0(area, '_id')), Xo = get(paste0(area, '_ons')), Xn = get(area))]))
bndT <- merge(boundaries[[area]], y, by.x = 'id', by.y = 'Xo')
bnd <- merge(boundaries[[area]], y, by.x = 'id', by.y = 'Xo', all.x = FALSE)
bndT <- merge(bndT[is.na(bndT$Y), 'id'], areas[type == area, .(ons_id, nhs_id, name)], by.x = 'id', by.y = 'ons_id')

# bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
# pal <- colorBin("YlOrRd", domain = states$density, bins = bins)

# mp <- leaflet() %>%
#         setView(-96, 37.8, 4) %>%
#         fitBounds(lng1 = 1.8, lat1 = 49.9, lng2 = -8.3, lat2 = 59.0 ) %>%
#         addTiles('http://{s}.tile.openstreetmap.fr/hot/{z}/{x}/{y}.png')

mp <- mp %>%
        addPolygons(data = bndT,
            stroke = TRUE,
            color = "#444444",
            opacity = 1.0,
            weight = 0.6,
            fill = TRUE,
            fillColor = "#E0E0E0",
            fillOpacity = 0.4,
            smoothFactor = 0.5,
            group = 'UK',
            highlightOptions = highlightOptions(
                color = "red",
                weight = 1,
                bringToFront = TRUE
            ),
            label = lapply(paste0(bndT$name, ': <b>NOT supported</b>'), HTML),
            labelOptions = labelOptions(
                textsize = "12px",
                direction = "auto",
                style = list("font-weight" = "normal", padding = "3px 8px")
            )
        )

mp <- mp %>%
        addPolygons(data = bnd,
            color = "#444444",
            weight = 1,
            smoothFactor = 0.5,
            opacity = 1.0,
            fillOpacity = 0.5,
            fillColor = ~colorQuantile("YlOrRd", Y)(Y),
            highlightOptions = highlightOptions(
                color = "white",
                weight = 3,
                bringToFront = TRUE
            ),
            label = lapply(
                        paste0(
                            area, ': ', bnd$Xn, '<br/>',
                            metric, ':<b>', if(pct) { paste0(100*bnd$Y, '%') } else {bnd$Y}, '</b>'
                        ),
                    HTML
            ),
            labelOptions = labelOptions(
                textsize = "15px",
                direction = "auto",
                style = list("font-weight" = "normal", padding = "3px 8px")
            )
        )

mp <- mp %>%
        addLegend(
            pal = colorBin(
                    "YlOrRd",
                    domain = states$density,
                    bins = bins
            ),
            values = ~density,
            opacity = 0.7,
            title = NULL,
            position = "bottomright"
        )

mp



# save map as html
saveWidget(mp, file = 'mapnmae.html')

# save map as image: you need mapview and webshot packages, plus phantomJS
mapshot(mp, file = 'mapname.png')