ไฮไลต์รูปหลายเหลี่ยมแผ่นพับ R ที่ชี้โดยเลือกรายการ (โดยไม่ต้องคลิก)

ในแอป R Shiny เป็นไปได้ไหมที่จะมีแผนที่แผ่นพับที่เน้นรูปหลายเหลี่ยมที่ชี้โดย Select Item (ควรใช้งานได้เพียงแค่เลื่อนมูสไปเหนือรายการและไม่ต้องคลิก)

ในตัวอย่างที่ทำซ้ำได้ต่อไปนี้ ฉันต้องการให้แอป 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)

ขอบคุณมาก !


r leaflet shiny shinyjs
person JeanBertin    schedule 13.09.2018    source แหล่งที่มา

คำตอบ (1)


arrow_upward
3
arrow_downward

นั่นควรทำเคล็ดลับ:

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)
person thothal    schedule 19.09.2018
comment
เป็นเพียงคำถามเล็ก ๆ เกี่ยวกับคำตอบที่ยอดเยี่ยมของคุณ: เป็นไปได้ที่จะเริ่มต้นค่า selectInput ใหม่เป็น NULL (นั่นหมายความว่าไม่ได้เลือกรูปหลายเหลี่ยม) เมื่อเมาส์ของผู้ใช้ออกจากพื้นที่ตัวเลือก - person JeanBertin; 20.09.2018
comment
อัปเดตคำตอบของฉัน คุณต้องใช้เหตุการณ์ mouseleave เพื่อตั้งค่า abck เป็น null - person thothal; 20.09.2018
comment
คุณเป็นอัจฉริยะ! - person JeanBertin; 21.09.2018