r - 在R中悬停传单时弹出?

标签 r leaflet r-leaflet

我的传单 map 如下所示:

library(sp)
library(leaflet)
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
  r = diameter / 2
  tt <- seq(0,2*pi,length.out = npoints)
  xx <- center[1] + r * cos(tt)
  yy <- center[2] + r * sin(tt)
  Sr1 = Polygon(cbind(xx, yy))
  Srs1 = Polygons(list(Sr1), "s1")
  SpP = SpatialPolygons(list(Srs1), 1:1)
  return(SpP)
}
Circle.Town <- circleFun(c(1,-1),2.3,npoints = 100)

df1 <- data.frame(long=c(0.6,1,1.4), lat=c(-2, -.8, -0.2), other=c('a', 'b', 'c'), VAM=c(10,8,6), 
                  type=c('Public', 'Public', 'Private'), id=c(1:3)) %>% 
  mutate(X=paste0('<strong>id: </strong>', 
                  id,
                  '<br><strong>type</strong>: ',
                  type,
                  '<br><strong>VAM</strong>: ',
                  VAM))

# Create a continuous palette function
pal <- colorNumeric(
  palette = "RdYlBu",
  domain = df1$VAM
)

leaflet(height = "400px") %>% 
  addTiles() %>%
  addPolygons(data = Circle.Town, color = 'green',  fillOpacity = .7) %>%
  addCircleMarkers(data = df1, lat = ~lat, lng =~long, 
                   radius = ~VAM, popup = ~as.character(X), 
                   fillColor = ~pal(VAM),
                   stroke = FALSE, fillOpacity = 0.8,
                   clusterOptions = markerClusterOptions()) %>% 
  addLegend(position = "topright",
            pal = pal, values = df1$VAM,
            title = "VAM",
            opacity = 1
  ) %>% 
  setView(lng = 1, lat = -1, zoom = 8)

现在,当我单击其中一个圆圈时会弹出一个窗口。当我将鼠标悬停而不是单击时,是否可以获得信息?理想情况下,我想要 this .

谢谢!

最佳答案

自从一年前提出这个问题以来,这可能已添加到传单包中,但这可以通过 label 完成。争论。我正在使用传单 R 包版本 1.1.0。

读取数据如上:

library(sp)
library(leaflet)
library(dplyr)

circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
  r = diameter / 2
  tt <- seq(0,2*pi,length.out = npoints)
  xx <- center[1] + r * cos(tt)
  yy <- center[2] + r * sin(tt)
  Sr1 = Polygon(cbind(xx, yy))
  Srs1 = Polygons(list(Sr1), "s1")
  SpP = SpatialPolygons(list(Srs1), 1:1)
  return(SpP)
}
Circle.Town <- circleFun(c(1,-1),2.3,npoints = 100)

df1 <- data.frame(long=c(0.6,1,1.4), lat=c(-2, -.8, -0.2), other=c('a', 'b', 'c'), VAM=c(10,8,6), 
  type=c('Public', 'Public', 'Private'), id=c(1:3)) %>% 
  mutate(X=paste0('<strong>id: </strong>', 
    id,
    '<br><strong>type</strong>: ',
    type,
    '<br><strong>VAM</strong>: ',
    VAM))

# Create a continuous palette function
pal <- colorNumeric(
  palette = "RdYlBu",
  domain = df1$VAM
)

但是创建一个标签列表而不是向量:
labs <- as.list(df1$X)

然后 lapply HTMLlabel 中的该列表上运行争论。注意使用label而不是 popup .
library(htmltools)
leaflet(height = "400px") %>% 
  addTiles() %>%
  addPolygons(data = Circle.Town, color = 'green',  fillOpacity = .7) %>%
  addCircleMarkers(data = df1, lat = ~lat, lng =~long, 
    radius = ~VAM, label = lapply(labs, HTML), 
    fillColor = ~pal(VAM),
    stroke = FALSE, fillOpacity = 0.8,
    clusterOptions = markerClusterOptions()) %>% 
  addLegend(position = "topright",
    pal = pal, values = df1$VAM,
    title = "VAM",
    opacity = 1
  ) %>% 
  setView(lng = 1, lat = -1, zoom = 8)

此方法在此 SO 问题的答案中进行了描述:R and Leaflet: How to arrange label text across multiple lines

传单文档中的标签中有更多关于 HTML 的信息:
https://rstudio.github.io/leaflet/popups.html

关于r - 在R中悬停传单时弹出?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/30964020/

相关文章:

r - 在 qplot 中设置颜色标签和改变调色板

jquery - 如何在 Shiny 中返回 roundSlider 的值?

javascript::如何使用数组中的javascript变量在传单上绘制多边形

R Leaflet 不添加所有标记

r - 如何使用 dplyr `across()` 语法过滤全部为 NA 的行?

r - 我可以使用 geom_rug 添加第三个变量到图形吗?

javascript - 需要有关添加弹出传单的帮助

r - 在不添加和删除的情况下更新传单提供者磁贴选项

r - 在基组之间切换时是否可以在多个图例之间切换?

r - 以 Shiny 的方式过滤传单 map 数据