r - 突出显示由选择项指向的 R 传单多边形(不单击它)
问题描述
在 R 闪亮的应用程序上,是否有可能有一个传单地图突出显示由 select Item 指向的多边形(它应该只在列表上方移动 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)
非常感谢 !
解决方案
这应该够了吧:
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)
推荐阅读
- javascript - 反应js应用程序中带有令牌的firebase重新身份验证流程无法正常工作
- git - 如何推送/创建一个分支,以便它分配给 GitHub 中的问题?
- docker - 如何使用 docker 容器为 vue-cli-plugin-electron-builder 生成的 windows 平台构建应用程序
- pandas - 类型错误:“浮动”对象不可迭代
- php - HTML - PHP - 试图惰性化一个变量
- r - 创建一个闪亮的应用程序来执行数据操作
- python - 如何用python计算拐点?
- sql - 插入非重复记录以复制具有更新日期的表
- c++ - 函数模板参数推导
- terraform - 合并 terraform 中的对象列表