Search code examples
rshinyr-leaflet

Issue with selecting multiple filter options in R Shiny with Leaflet


I am working with R Shiny for the first time to produce an interactive Leaflet map. The map largely works without any issues, however there is one bug that I cannot figure out. I was hoping that someone might be able to assist me.

I am trying to plot data from each country in the UK (England, Scotland, Wales, and Northern Ireland) and include a filter so that users can select for which countries they would like to show the markers. I have used the shinyWidgets package pickerInput to do so. If a user chooses a single nation or selects all, the map displays without issue. If they choose certain combinations of multiple nations, the markers stop displaying as they should.

My data is in the form (DataMap.csv):

Country, Topic, Lat, Long, X1, X2, X3,
England, Topic 1, 51.5074, -0.1278, 1, a, TRUE
Scotland, Topic 1, 55.9533, -3.1883, 2, a, TRUE
Wales, Topic 1, 51.4816, -3.1791, 1, b, FALSE
Northern Ireland, Topic 1, 54.5973, -5.9301, 2, b, TRUE

I am working with three R files, and have included an minimal viable version below:

global.R

library(shiny)
library(shinythemes)
library(leaflet)
library(rgdal)
library(shinyWidgets)
library(shinydashboard)
library(dplyr)

# Read in the data
mapdata <- as.data.frame(read.csv("DataMap.csv", header = TRUE))

ui.R

ui <- dashboardPage(

      dashboardHeader(title = "Map"),
     
      dashboardSidebar(

      pickerInput("countryInput","Country", choices=c("England", "Wales", "Scotland", "Northern Ireland"), options = list(`actions-box` = TRUE),multiple = TRUE),

      pickerInput("topicInput","Topic", choices=c("Select topic...", "Topic 1", "Topic 2", ), selected = "Select topic...", options = list(`actions-box` = F),multiple = F)),

      dashboardBody(leafletOutput(outputId = 'map', height = 930)
        
       ))

server.R

      shinyServer(function(input, output) {
      output$map <- renderLeaflet({

      #Set basemap
      leaflet(mapdata) %>% 
      addProviderTiles(providers$Wikimedia) %>%
      setView(lat = 54.093409, lng = -2.89479,  zoom = 6) %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
      })

      #Select country
      selectedCountry <- reactive({
      mapdata[mapdata$Country == input$countryInput, ] 
      })

      observe({
      state_popup <- paste0("<strong>Country: </strong>", 
                      selectedCountry()$Country,
                      "<br><strong> Topic: </strong>",
                      selectedCountry()$Topic)

      leafletProxy("map", data = selectedCountry()) %>%
      clearMarkerClusters() %>%
      clearMarkers() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions()) 
      })

      #Select topic
      selectedTopic <- reactive({
      tmp <- mapdata[!is.na(mapdata$Topic), ] 
      tmp[tmp$Topic == input$topicInput, ]
      })

      observe({
      state_popup <- paste0("<strong>Country: </strong>",
                      selectedTopic()$Country,
                      "<br><strong> Topic: </strong>",
                      selectedTopic()$Topic)

      leafletProxy("map", data = selectedTopic()) %>%
      clearMarkers() %>%
      clearMarkerClusters() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
      })
      })

Example of the issue

Here I have selected all of the countries, and all 6 of the markers are showing for each nation

Here I have selected 3 countries, and only 2 markers are showing per nation


Solution

  • A few things you should consider for next time.

    Use dput() on your dataframe to give us a quick way to use your data and run your code in a fresh r session before posting to check if it actually runs. You have a comma after "Topic 2" which throws out an error.

    pickerInput("topicInput","Topic", choices=c("Select topic...", "Topic 1", "Topic 2", )...

    If you run your code you should get something like

    Warning in mapdata$Country == input$countryInput : longer object length is not a multiple of shorter object length

    To fix that problem just try following

    server <- function(input, output) {
      output$map <- renderLeaflet({
    
        #Set basemap
        leaflet(mapdata) %>% 
          addProviderTiles(providers$Wikimedia) %>%
          setView(lat = 54.093409, lng = -2.89479,  zoom = 6)
      })
    
      #Select country
      selectedCountry <- reactive({
        mapdata[mapdata$Country %in% input$countryInput, ] # here you want to change to %in% as == does a element wise checking for equality
      })
    
      observe({
        state_popup <- paste0("<strong>Country: </strong>", 
                              selectedCountry()$Country,
                              "<br><strong> Topic: </strong>",
                              selectedCountry()$Topic)
    
        leafletProxy("map", data = selectedCountry()) %>%
          clearMarkerClusters() %>%
          clearMarkers() %>%
          addMarkers(~long, ~lat, clusterOptions = markerClusterOptions()) 
      })
    
      #Select topic
      selectedTopic <- reactive({
        tmp <- mapdata[!is.na(mapdata$Topic), ] 
        tmp[tmp$Topic == input$topicInput, ]
      })
    
      observe({
        state_popup <- paste0("<strong>Country: </strong>",
                              selectedTopic()$Country,
                              "<br><strong> Topic: </strong>",
                              selectedTopic()$Topic)
    
        leafletProxy("map", data = selectedTopic()) %>%
          clearMarkers() %>%
          clearMarkerClusters() %>%
          addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
      })
    }
    shinyApp(ui, server)
    

    You can also check Why do I get “warning longer object length is not a multiple of shorter object length”?

    Hope that helps.