Wyskakiwanie po najechaniu z ulotką w R?

Question

Moja ulotka mapa wygląda mniej więcej tak:

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) 

Teraz dostaję okienko po kliknięciu jednego z kręgów. Czy możliwe jest uzyskanie informacji po najechaniu myszą zamiast kliknięcia? Idealnie, chciałbym coś takiego jak this.

Dzięki!

Answer 1

To mogło być dodane do pakietu ulotek, ponieważ pytanie to zostało zadane rok temu, ale można to zrobić za pomocą argumentu label. Używam pakietu ulotek R w wersji 1.1.0.

odczytywać dane w jak powyżej:

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 
) 

Ale utworzyć listę etykiet zamiast wektora:

labs <- as.list(df1$X) 

A potem lapply wyboru funkcji HTML na tej liście w label argument. Uwaga: należy użyć label zamiast 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) 

Metoda ta jest opisana w odpowiedzi na ten SO pytanie: R and Leaflet: How to arrange label text across multiple lines

jest więcej informacji na temat HTML w etykietach w dokumentacji PACJENTA: https://rstudio.github.io/leaflet/popups.html

Answer 2

Oto alternatywa:

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

W pulpicie, trzeba będzie html i folder zapisany pod yourmap. Otwórz plik leaflet.js znajdujący się w katalogu /pathTo/twojeklamy_pliku/leaflet-binding-1.0.1.9002. W leaflet.js, przewiń do var popup = df.get(i, 'popup'); i wklej tuż poniżej:

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

Zapisz i ponownie yourmap.html pliku. Najedź na jeden z twoich punktów !!