I would like to make an interactive map with flows where I can easily see the direction of the flow.
I have data of flows passing multiple locations. So the flow goes from a starting point to a finish point, optionally passing other locations.
With R Leaflet and Shiny I created an interactive map with filter options. So far so good, but I would like to add arrows to indicate the direction of the flow. I got the polylinedecorator plugin working, but the arrows remain on the map, even when the corresponding flow is not selected.
I tried:
- Adjusting clearshapes and clearmarkers, but they don’t seem to affect the arrows.
- Moving the polylinedecorator to leafletproxy instead of leaflet, but then I didn’t get arrows at all.
Any suggestions how I can remove the ‘old’ arrows? Thanks!
The code:
library(tidyverse)
library(leaflet)
library(shiny)
library(shinyWidgets)
library(htmltools)
# Polylinedecorator plugin for arrows
download.file(
'https://raw.githubusercontent.com/bbecquet/Leaflet.PolylineDecorator/master/dist/leaflet.polylineDecorator.js',
'leaflet.polylineDecorator.js')
polylineDecoratorPlugin <- htmlDependency('Leaflet.PolylineDecorator',
'1.6.0',
src = normalizePath('.'),
script = 'leaflet.polylineDecorator.js')
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
# Tibble with flows
flows <-
tribble(
~route, ~amount, ~finish, ~lat, ~lon,
"A-R", 100, "R", 52.3702157, 4.895167899999933,
"A-R", 100, "R", 51.9228958, 4.4631727,
"A-U-E", 200, "E", 52.3702157, 4.895167899999933,
"A-U-E", 200, "E", 52.0809856, 5.127684,
"A-U-E", 200, "E", 51.4485569, 5.4501225,
"M-L-G", 50, "G", 50.84984588623047, 5.687259197235107,
"M-L-G", 50, "G", 53.20265579223633, 5.790334224700928,
"M-L-G", 50, "G", 53.2217925, 6.5582453
)
# Shiny: User Interface
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput(inputId = "range",
label = "amount",
min = min(flows$amount),
max = max(flows$amount),
value = c(100, max(flows$amount)),
step = 10),
selectInput(inputId = "finish",
label = "final location",
choices = unique(flows$finish))
)
)
# Shiny: Server
server <- function(input, output, session) {
filteredData <- reactive({
flows[flows$amount >= input$range[1]
& flows$amount <= input$range[2],]
})
output$map <- renderLeaflet({
leaflet(flows) %>%
registerPlugin(polylineDecoratorPlugin) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(~min(lon), ~min(lat), ~max(lon), ~max(lat)) %>%
htmlwidgets::onRender(
"function(el,x,data) {
var myMap = this;
myMap.on('layeradd',
function(e) {
var lyr = e.layer;
if ('need_decorator' in lyr.options) {
var dec = L.polylineDecorator(lyr, {
patterns: [
{offset: 0, repeat: '20%', symbol: L.Symbol.arrowHead({pixelSize:15, pathOptions:{stroke:true}})}
]
}).addTo(myMap);
}
}
);
}")
})
observe({
selection <- filteredData()
selection <- selection %>% dplyr::filter(finish %in% input$finish)
n <- leafletProxy("map", data = selection) %>%
clearShapes()
for (i in unique(selection$route)) {
n <- n %>%
addPolylines(data = selection[selection$route == i, ],
lng = ~lon,
lat = ~lat,
weight = ~sqrt(amount),
popup = ~paste("Route:",route,
"Amount:", amount),
options = list(need_decorator = T)
)
}
})
}
shinyApp(ui, server)