rshinyr-leafletshinyjs

Highlight R leaflet polygon pointed by select Item (without clicking on it)


In an R shiny app, is it possible to have a leaflet map that highlights polygons pointed by select Item (it should work just moving the mouse above the list and without having clicking on it) ?

In the following reproducible example, I would like this Shiny app to highlight the polygon corresponding to the mouse cursor location but without having to click on it.

library(shiny)
library(shinyjs)
library(leaflet)
library(sf)

download.file(url = "http://thematicmapping.org/downloads/TM_WORLD_BORDERS-0.3.zip", destfile = "TM_WORLD_BORDERS-0.3.zip")
unzip( zipfile = "TM_WORLD_BORDERS-0.3.zip" )

world.borders <-read_sf( dsn = getwd(), layer = "TM_WORLD_BORDERS-0.3" )
world.borders <- world.borders[world.borders$NAME %in% c("Australia","United States","Brazil","Ireland","India","Kenya"),]

server <- function(input, output, session) {

output$mymap <- renderLeaflet({
    leaflet(options = leafletOptions(maxZoom = 18)) %>% addTiles() %>%
       addPolygons( data = world.borders, fill =  "#D24618", color = "blue")
 }) 
}

 ui <- fluidPage(
     leafletOutput("mymap"),
     selectInput(inputId = "country_choice",label = "Select a country",choices = unique(world.borders$NAME))
)

shinyApp(ui, server)

Solution

  • That should do the trick:

    library(shiny)
    library(shinyjs)
    library(leaflet)
    library(sf)
    
    ### Note had to download by hand as this did not work
    ## download.file(url = "http://thematicmapping.org/downloads/TM_WORLD_BORDERS-0.3.zip", 
    ##               destfile = "TM_WORLD_BORDERS-0.3.zip")
    ## unzip( zipfile = "TM_WORLD_BORDERS-0.3.zip" )
    
    world.borders <- read_sf( dsn = getwd(), layer = "TM_WORLD_BORDERS-0.3" )
    world.borders <- world.borders[world.borders$NAME %in% 
                                   c("Australia", "United States", "Brazil", 
                                     "Ireland", "India", "Kenya"), ]
    
    ui <- fluidPage(
      useShinyjs(),
      leafletOutput("mymap"),
      selectInput(inputId = "country_choice",
                  label   = "Select a country",
                  choices = c("Please Select..." = "", unique(world.borders$NAME)))
    )
    
    server <- function(input, output, session) {
    runjs(glue::glue("$('.selectize-control').on('mouseenter', ",
                     "'.selectize-dropdown-content div', ",
                     "function() {{",
                     "    Shiny.setInputValue('selected', $(this).data('value'));}}); ",
                     "$('.selectize-control').on('mouseleave', ",
                     "'.selectize-dropdown-content div', ",
                     "function() {{",
                     "    Shiny.setInputValue('selected', null);}})"))
    
      output$mymap <- renderLeaflet({
        myBorders <- world.borders[world.borders$NAME == input$selected, ]
        leaflet(options = leafletOptions(maxZoom = 18)) %>% addTiles() %>%
          addPolygons(data = myBorders, fill =  "#D24618", color = "blue")
      }) 
    }
    
    shinyApp(ui, server)