library(mapdeck)
Because Deck.gl is one of the most user-friendly WebGL javascript libraries and can produce some beautiful maps. And it integrates nicely with Mapbox.
You need a Mapbox Access Token to load a map. Then call mapdeck(token = token)
to give you a map
key <- 'abc' ## put your own token here
mapdeck(token = key)
You can use set_token()
to make your token available ‘globally’ to all future calls to mapdeck()
.
set_token('abc')
mapdeck_tokens()
# Mapdeck tokens
# - mapbox : abc
You can style the map using any mapbox style template styles, or you can create one of your own
mapdeck(token = key, style = 'mapbox://styles/mapbox/dark-v9')
I’ve provided a convenience function to select one of the mapbox defined styles
mapdeck_style(style = 'dark')
Once you have a map you can start adding layers through the various add_*()
functions (there is an example of each one in this vignette).
Each layer requires a layer_id
value. If you don’t supply one, it will create it for you, but this may have some unintended consequences for you.
The layer_id
is the ID that deck.gl
uses to ‘shallow-compare’ layers to see if they need updating. Which comes in handy when working in Shiny. If you update data, for example when using a reactive()
function, and use the same layer_id
, deck.gl
knows it should update the layer rather than re-draw it completely.
However, if two of your layers have the same layer_id
, then deck.gl
will get confused and start updating the wrong thing. So while I’ve made the layer_id
argument optional, you should still set it manually when using it in Shiny apps.
All layers support simple feature sf
objects. In each layer section I specify which type of sfc
object is supported
url <- 'https://raw.githubusercontent.com/plotly/datasets/master/2011_february_aa_flight_paths.csv'
flights <- read.csv(url)
flights$id <- seq_len(nrow(flights))
flights$stroke <- sample(1:3, size = nrow(flights), replace = T)
mapdeck( token = key, style = 'mapbox://styles/mapbox/dark-v9', pitch = 45 ) %>%
add_arc(
data = flights
, layer_id = "arc_layer"
, origin = c("start_lon", "start_lat")
, destination = c("end_lon", "end_lat")
, stroke_from = "airport1"
, stroke_to = "airport2"
, stroke_width = "stroke"
)
sf : supports sf
objects with two POINT or MULTIPOINT geometry columns.
mapdeck(
token = key
, style = mapdeck_style("dark")
, pitch = 35
) %>%
add_geojson(
data = geojson
, layer_id = "geojson"
)
sf : supports all sf
geometry types. Converted to geojson using geojsonsf::sf_geojson()
. Useful if your sf
object contains different geometry types.
df <- read.csv(paste0(
'https://raw.githubusercontent.com/uber-common/deck.gl-data/master/',
'examples/3d-heatmap/heatmap-data.csv'
))
mapdeck( token = key, style = mapdeck_style("dark"), pitch = 45 ) %>%
add_grid(
data = df
, lat = "lat"
, lon = "lng"
, cell_size = 5000
, elevation_scale = 50
, layer_id = "grid_layer"
)
sf : supports sf
objects with POINT and MULTIPOINT geometries
url <- 'https://raw.githubusercontent.com/plotly/datasets/master/2011_february_aa_flight_paths.csv'
flights <- read.csv(url)
flights$id <- seq_len(nrow(flights))
flights$stroke <- sample(1:3, size = nrow(flights), replace = T)
mapdeck( token = key, style = mapdeck_style("dark"), pitch = 45 ) %>%
add_line(
data = flights
, layer_id = "line_layer"
, origin = c("start_lon", "start_lat")
, destination = c("end_lon", "end_lat")
, stroke_colour = "airport1"
, stroke_width = "stroke"
)
sf : supports sf
objects with two POINT and MULTIPOINT geometry columns.
mapdeck(
token = key
, style = mapdeck_style("dark")
, zoom = 10) %>%
add_path(
data = roads
, stroke_colour = "RIGHT_LOC"
, layer_id = "path_layer"
)
sf : supports sf
objects with LINESTRING and MULTILINESTRING geometries
df <- capitals
df$z <- sample(10000:10000000, size = nrow(df))
mapdeck(token = key, style = mapdeck_style("dark")) %>%
add_pointcloud(
data = df
, lon = 'lon'
, lat = 'lat'
, elevation = 'z'
, layer_id = 'point'
, fill_colour = "country"
)
sf : supports sf
objects with POINT and MULTIPOINT geometries
library(sf)
library(geojsonsf)
sf <- geojson_sf("https://symbolixau.github.io/data/geojson/SA2_2016_VIC.json")
mapdeck(token = key, style = mapdeck_style("dark")) %>%
add_polygon(
data = sf
, layer = "polygon_layer"
, fill_colour = "SA2_NAME16"
)
sf : supports sf
objects with POLYGON and MULTIPOLYGON geometries
mapdeck( token = key, style = mapdeck_style("dark"), pitch = 45 ) %>%
add_scatterplot(
data = capitals
, lat = "lat"
, lon = "lon"
, radius = 100000
, fill_colour = "country"
, layer_id = "scatter_layer"
)
sf : supports sf
objects with POINT and MULTIPOINT geometries
df <- read.csv(paste0(
'https://raw.githubusercontent.com/uber-common/deck.gl-data/master/',
'examples/3d-heatmap/heatmap-data.csv'
))
df$weight <- sample(1:10, size = nrow(df), replace = T)
mapdeck( token = key, style = mapdeck_style('dark'), pitch = 45 ) %>%
add_screengrid(
data = df
, lat = "lat"
, lon = "lng"
, weight = "weight"
, layer_id = "screengrid_layer"
, cell_size = 10
, opacity = 0.3
)
sf : supports sf
objects with POINT and MULTIPOINT geometries
mapdeck(token = key, style = mapdeck_style('dark')) %>%
add_text(
data = capitals
, lon = 'lon'
, lat = 'lat'
, fill_colour = 'country'
, text = 'capital'
, layer_id = 'text'
)
sf : supports sf
objects with POINT and MULTIPIONT geometries
df1 <- capitals[ capitals$country == "Australia", ]
df2 <- capitals[ capitals$country != "Australia", ]
df1$key <- 1L
df2$key <- 1L
df <- merge(df1, df2, by = 'key')
mapdeck(
token = key
, style = mapdeck_style("dark")
, pitch = 35
) %>%
add_arc(
data = df
, origin = c("lon.x", "lat.x")
, destination = c("lon.y", "lat.y")
, layer_id = "arc_layer"
, stroke_from = "country.x"
, stroke_to = "country.y"
, stroke_width = 2
) %>%
add_scatterplot(
data = df2
, lon = "lon"
, lat = "lat"
, radius = 100000
, fill_colour = "country"
, layer_id = "scatter"
)
The three main functions to use are
render_mapdeck()
in the Servermapdeck_output()
in the UImapdeck_update()
to update an existing mapYou can observe interactions with the layers by using observeEvent()
. The event you observe is formed by combining
'map_id + "_" + layer + "_click"
where
map_id
is the outputId
of the mapdeckOutput()
functionlayer
is the layer you’re interacting with_click
is you observing ‘clicking’ on the layerThere’s an example of this in the shiny.
library(shiny)
library(shinydashboard)
library(jsonlite)
ui <- dashboardPage(
dashboardHeader()
, dashboardSidebar()
, dashboardBody(
mapdeckOutput(
outputId = 'myMap'
),
sliderInput(
inputId = "longitudes"
, label = "Longitudes"
, min = -180
, max = 180
, value = c(-90, 90)
)
, verbatimTextOutput(
outputId = "observed_click"
)
)
)
server <- function(input, output) {
#set_token('abc') ## set your access token
origin <- capitals[capitals$country == "Australia", ]
destination <- capitals[capitals$country != "Australia", ]
origin$key <- 1L
destination$key <- 1L
df <- merge(origin, destination, by = 'key', all = T)
output$myMap <- renderMapdeck({
mapdeck(style = mapdeck_style('dark'))
})
## plot points & lines according to the selected longitudes
df_reactive <- reactive({
if(is.null(input$longitudes)) return(NULL)
lons <- input$longitudes
return(
df[df$lon.y >= lons[1] & df$lon.y <= lons[2], ]
)
})
observeEvent({input$longitudes}, {
if(is.null(input$longitudes)) return()
mapdeck_update(map_id = 'myMap') %>%
add_scatterplot(
data = df_reactive()
, lon = "lon.y"
, lat = "lat.y"
, fill_colour = "country.y"
, radius = 100000
, layer_id = "myScatterLayer"
) %>%
add_arc(
data = df_reactive()
, origin = c("lon.x", "lat.x")
, destination = c("lon.y", "lat.y")
, layer_id = "myArcLayer"
, id = "country.x"
, stroke_width = 4
)
})
## observe clicking on a line and return the text
observeEvent(input$myMap_arc_click, {
event <- input$myMap_arc_click
output$observed_click <- renderText({
jsonlite::prettify( event )
})
})
}
shinyApp(ui, server)