Refresh arrows from Leaflet PolylineDecorator in R Shiny to create an interactive flow map

Viewed 559

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)

0 Answers
Related