突出显示由选择项指向的 R 传单多边形（不单击它）

Posted 2023-03-24

【中文标题】突出显示由选择项指向的 R 传单多边形（不单击它）

【英文标题】：Highlight R leaflet polygon pointed by select Item (without cliking on it)

【发布时间】：2019-02-18 08:06:46

【问题描述】：

在 R 闪亮的应用程序上，是否有可能有一个传单地图突出显示由选择项指向的多边形（它应该只移动列表上方的 mouss 而无需单击它）？

在以下可重现的示例中，我希望这个 Shiny 应用程序突出显示与鼠标光标位置对应的多边形，但不必单击它。

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)

非常感谢！

【参考方案1】：

这应该可以解决问题：

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)

【讨论】：

只是一个关于您的好答案的小问题：当用户的鼠标退出选择器区域时，是否可以将 selectInput 值重新初始化为 NULL（这意味着没有选择多边形）？

更新了我的答案，你必须使用mouseleave事件将值abck设置为null

你是个天才！