Popup khi di chuột với tờ rơi trong R?

Question

Bản đồ của tôi tờ rơi trông giống như sau:

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) 

Ngay bây giờ, tôi nhận được một popup khi tôi nhấp vào một trong các vòng tròn. Có thể lấy thông tin khi tôi di chuột thay vì nhấp chuột không? Lý tưởng nhất, tôi muốn một cái gì đó như this.

Cảm ơn!

Answer 1

Điều này có thể đã được thêm vào gói tờ rơi vì câu hỏi này được đặt ra cách đây một năm, nhưng điều này có thể được thực hiện thông qua đối số label. Tôi đang sử dụng gói R gói phiên bản 1.1.0.

đọc dữ liệu trong như trên:

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 
) 

Nhưng tạo ra một danh sách các nhãn thay vì vector:

labs <- as.list(df1$X) 

Và sau đó lapply các HTML chức năng trên danh sách đó trong lập luận label. Lưu ý sử dụng label thay vì 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) 

Phương pháp này được mô tả trong một câu trả lời cho câu hỏi này SO: R and Leaflet: How to arrange label text across multiple lines

Có biết thêm về HTML trong nhãn trong tài liệu tờ rơi: https://rstudio.github.io/leaflet/popups.html

Answer 2

Đây là một sự thay thế:

library(leaflet) 
library(htmltools) 
library(htmlwidgets) 

yourmap <- 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) 

setwd("~/Desktop/") 
saveWidget(yourmap, file="yourmap.html") 

Trong máy tính của bạn, bạn sẽ có một html và một thư mục lưu dưới yourmap. Mở tệp leaflet.js nằm trong /pathTo/yourmap_files/leaflet-binding-1.0.1.9002. Trong leaflet.js, di chuyển xuống var popup = df.get(i, 'popup'); và dán ngay dưới:

  marker.on('mouseover', function (e) { 
    this.openPopup(); 
}); 
marker.on('mouseout', function (e) { 
    this.closePopup(); 
}); 

Lưu và mở lại tập tin yourmap.html. Di chuột vào một trong những điểm của bạn !!