R Leaflet:当多边形不可点击时,是否可以显示多边形标签?

时间:2017-03-23 18:26:19

标签: r shiny leaflet

当在多边形上移动鼠标时,我需要显示多边形的标签(带有区域的名称)。但是多边形无法点击,因为我将此属性用于我的代码的另一部分。这可能吗?

如果无法做到这一点,另一种解决办法就是在多边形上写一个名字。我也不知道怎么做。 :/

以下是我的代码到目前为止的样子

library(shiny)
library(leaflet)

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)

# Load shapefiles
shp_Tajo <- readOGR(dsn = "./Data/ES", layer = "Aqueduct_river_basins_TEJO", verbose = FALSE)

server <- function(input, output, session){ 
output$map <- renderLeaflet({
      # Arguments controlling the looks of the basin polygon
      dopacity = 0.3
      dsmoothFactor = 1
      dfillOpacity = 0.5
      vcolors = c("red")
      leaflet() %>% addTiles() %>% addPolygons(data = shp_Tajo, stroke = F,
opacity = dopacity, smoothFactor = dsmoothFactor, color = vcolors[1], fillColor = vcolors[1], 
fillOpacity = dfillOpacity, highlightOptions = highlightOptions(color = "white", weight = 2, 
bringToFront = FALSE), options = pathOptions(clickable = FALSE), label = "Tajo",
labelOptions = labelOptions(noHide = T, clickable = T, textOnly = TRUE, opacity=0.5,textsize='15px'))
  })
}

形状文件可以从http://riverbasins.wateractionhub.org/#find_lat_lng下载 ,您必须在下拉菜单中选择西班牙。

非常感谢任何帮助!

1 个答案:

答案 0 :(得分:0)

通过注释掉pathOptions设置,它可以按预期工作:您可以点击除多边形以外的任何位置,并在鼠标悬停时显示多边形的标签:

工作示例:

enter image description here

library("shiny")
library("rgdal")
library("leaflet")
library("ggmap")

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%")
)

# Load shapefiles
shp_Tajo <- readOGR(dsn = "./Data/ES", layer = "Aqueduct_river_basins_TEJO", verbose = FALSE)

server <- function(input, output, session){ 
  output$map <- renderLeaflet({
    # Arguments controlling the looks of the basin polygon
    dopacity = 0.3
    dsmoothFactor = 1
    dfillOpacity = 0.5
    vcolors = c("red")
    leaflet() %>% 
      addTiles() %>% 
      addPolygons(
        data = shp_Tajo
        , stroke = FALSE
        , opacity = dopacity
        , smoothFactor = dsmoothFactor
        , color = vcolors[1]
        , fillColor = vcolors[1]
        , fillOpacity = dfillOpacity
        , highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = FALSE)
        # , options = pathOptions(clickable = FALSE)
        , label = "Tajo"
        , labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, opacity = 0.5 , textsize='15px'))
  })

  observeEvent(input$map_click, {
    click <- input$map_click
    clat <- click$lat
    clng <- click$lng

    leafletProxy('map') %>% 
      addCircles(
        lng = clng
        , lat = clat
        , group = 'circles'
        , weight = 1
        , radius = 5000
        , color = 'black'
        , fillColor = 'orange'
        , fillOpacity = 0.5
        , opacity = 1
        )
  })
}

shinyApp(ui, server)
相关问题